[Pkg] The Trunk: EToys-tfel.176.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Aug 31 08:21:31 UTC 2016


Tim Felgentreff uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-tfel.176.mcz

==================== Summary ====================

Name: EToys-tfel.176
Author: tfel
Time: 6 August 2016, 1:15:44.705858 pm
UUID: 0ebd1e57-7a59-4f8a-bb4b-a001f5ff01f2
Ancestors: EToys-tfel.175

update order of setting the images, to work with latest trunk changes

=============== Diff against EToys-pre.141 ===============

Item was changed:
  SystemOrganization addCategory: #'Etoys-Buttons'!
  SystemOrganization addCategory: #'Etoys-CustomEvents'!
  SystemOrganization addCategory: #'Etoys-Experimental'!
  SystemOrganization addCategory: #'Etoys-Outliner'!
  SystemOrganization addCategory: #'Etoys-Protocols'!
  SystemOrganization addCategory: #'Etoys-Protocols-Type Vocabularies'!
  SystemOrganization addCategory: #'Etoys-Scripting'!
  SystemOrganization addCategory: #'Etoys-Scripting Support'!
  SystemOrganization addCategory: #'Etoys-Scripting Tiles'!
  SystemOrganization addCategory: #'Etoys-Stacks'!
  SystemOrganization addCategory: #'Etoys-StarSqueak'!
  SystemOrganization addCategory: #'Etoys-Support'!
  SystemOrganization addCategory: #'Etoys-Tests'!
  SystemOrganization addCategory: #'Etoys-Tile Scriptors'!
  SystemOrganization addCategory: #'Etoys-Widgets'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Balloon-Geometry'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Collections-SkipLists'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Compiler-Syntax'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Compiler-Support'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Kernel-Methods'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Kernel-Contexts'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Kernel-Processes'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Kernel-Classes'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-System-Support'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-System-Applications'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-System-Exceptions Kernel'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-System-Compiler'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-System-Environments'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-System-Clipboard-Extended'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Tokenizer'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Forms'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Network-TelNet WordNet'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Parser'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Formatter'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Network-MIME'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Network-Kernel'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Network-Url'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Network-UI'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Multilingual-TextConversion'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Multilingual-Scanning'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Multilingual-Languages'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-Display Objects'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-Tools-Intersection'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-Tools-Simplification'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-Tools-Triangulation'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-External'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-Text'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Protocols-Type Vocabularies'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Sound-Interface'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Sound-Scores'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Sound-Ogg'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-ST80-Morphic'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-SUnit'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Tools-Changes'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Tools-File Contents Browser'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Tools-Explorer'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Tools-Process Browser'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-PDA'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Widgets'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Basic'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Games-Chess'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Demo'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Components'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Games'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Mentoring'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Models'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Experimental'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Books'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Windows'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-PartsBin'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Worlds'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Support'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-GeeMail'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Navigators'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Kernel'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-WebCam'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-Postscript Filters'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-Widgets'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-Charts'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-AdditionalMorphs'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Buttons'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Debugger'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Scratch'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Scripting'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-EToys-Kedama'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Scripting Tiles'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Help'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Tile Scriptors'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Scripting Support'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Calendar'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Input'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-SpeechBubbles'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Sugar'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-BroomMorphs-Base'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-BroomMorphs-Connectors'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Tweak-Kedama-ObjectVectors'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Tweak-Kedama-ParseTreeTransformer'!
+ SystemOrganization addCategory: #'Etoys-Squeakland-Tweak-Kedama-ParseTree-AttributeDefinition'!

Item was added:
+ ----- Method: AbstractFont>>widthOfStringWithPango: (in category '*Etoys-Squeakland-measuring') -----
+ widthOfStringWithPango: aString
+ 
+ 	| r utf8ContentsSize attrs myLines tl f |
+ 	aString ifNil:[^0].
+ 	r := RomePluginCanvas composingCanvas.
+ 	utf8ContentsSize := (aString ifNotNil: [(r primUtf8StringFor: aString andIndexFor: -1 into: (Array new: 2) nullFlag: false) first size] ifNil: [0]).
+ 	f := RomePangoFont familyName: (RomePangoFont familyNameFrom: self)  size: self pointSize.
+ 	attrs := Array with: (Array with: #F with: 0 with: utf8ContentsSize with: f descriptionIndex with: f).
+ 	myLines := r pangoComposeString: aString attributeArray: attrs at: 0 at 0 width: SmallInteger maxVal height: SmallInteger maxVal withWrap: false.
+ 	myLines ifNotNil: [
+ 		myLines second size > 0 ifFalse: [^ 0].
+ 		tl := myLines second first.
+ 		^ tl bottomRight x - tl topLeft x.
+ 	].
+ 	^ 0!

Item was added:
+ ----- Method: AbstractSound>>codecSignature (in category '*Etoys-Squeakland-as yet unclassified') -----
+ codecSignature
+ 	"Backstop..."
+ 
+ 	^ nil!

Item was added:
+ ----- Method: AbstractSound>>durationInMilliseconds (in category '*Etoys-Squeakland-accessing') -----
+ durationInMilliseconds
+ 	"Answer the duration in milliseconds."
+ 
+ 	^ self duration * 1000!

Item was added:
+ ----- Method: AbstractSound>>isCompressed (in category '*Etoys-Squeakland-accessing') -----
+ isCompressed
+ 	^ false!

Item was added:
+ ----- Method: AlignmentMorph>>addVariableTransparentSpacer (in category '*Etoys-Squeakland-initialization') -----
+ addVariableTransparentSpacer
+ 	"Add a new variable transparent receiver to the receiver."
+ 
+ 	self addMorphBack: AlignmentMorph newVariableTransparentSpacer!

Item was added:
+ ----- Method: AllPlayersTool class>>allPlayersToolForActiveWorld (in category '*Etoys-Squeakland-parts bin') -----
+ allPlayersToolForActiveWorld
+ 	"Launch an AllPlayersTool to view the scripted objects of the active world"
+ 
+ 	| aTool |
+ 	aTool _ self newStandAlone.
+ 	aTool center: ActiveWorld center.
+ 	^ aTool
+ 
+ "
+ AllPlayersTool allPlayersToolForActiveWorld
+ "!

Item was changed:
  ----- Method: AllPlayersTool class>>defaultNameStemForInstances (in category 'instance-creation defaults') -----
  defaultNameStemForInstances
  	"Answer the default name stem for new instances of this class"
  
+ 	^ 'Players' translatedNoop!
- 	^ 'Players'!

Item was changed:
  ----- Method: AllPlayersTool class>>descriptionForPartsBin (in category 'parts bin') -----
  descriptionForPartsBin
  	"Answer a description for use in parts bins"
  
+ 	^ self partName: 	'Players' translatedNoop
+ 		categories:		{'Scripting' translatedNoop}
+ 		documentation:	'A tool showing all the players in your project' translatedNoop!
- 	^ self partName: 	'Players'
- 		categories:		#('Scripting')
- 		documentation:	'A tool showing all the players in your project'!

Item was changed:
  ----- Method: AllPlayersTool>>addCustomMenuItems:hand: (in category 'menus') -----
  addCustomMenuItems: aMenu hand: aHand
  	"Add further items to the menu"
  
+ 	aMenu add: 'reinvigorate' translated target: self action: #reinvigorate.
+ 	Preferences eToyFriendly ifFalse: [aMenu add: 'inspect' translated target: self action: #inspect]!
- 	aMenu add: 'reinvigorate' target: self action: #reinvigorate.
- 	Preferences eToyFriendly ifFalse: [aMenu add: 'inspect' target: self action: #inspect]!

Item was changed:
  ----- Method: AllPlayersTool>>addHeaderRow (in category 'initialization') -----
  addHeaderRow
  	"Add the header morph at the top of the tool"
  
+ 	| aRow aButton |
+ 	aRow _ AlignmentMorph newRow.
- 	| aRow title aButton |
- 	aRow := AlignmentMorph newRow.
  	aRow listCentering: #justified; color: Color transparent.
+ 	aButton _ self tanOButton.
- 	aButton := self tanOButton.
- 	aButton actionSelector: #delete.
  	aRow addMorphFront: aButton.
+ 	aRow addMorphBack: (StringMorph contents: 'Players in this Project' translated font: ScriptingSystem fontForTiles).
+ 
- 	aRow addMorphBack: (title := StringMorph contents: 'Gallery of Players' translated).
- 	title setBalloonText: 'Double-click here to refresh the contents' translated.
- 	title on: #doubleClick send: #reinvigorate to: self.
  	aRow addMorphBack: self helpButton.
  	self addMorphFront: aRow.
  !

Item was added:
+ ----- Method: AllPlayersTool>>helpString (in category '*Etoys-Squeakland-menus') -----
+ helpString
+ 	"Answer a string of help"
+ 
+ 	^ 'Each row represents an object, or "player" in the project.
+ Click on the menu icon to get a menu of options concerning the player.
+ Click on a player''s picture to reveal its location.
+ Click on the turquoise eye to open the player''s viewer.
+ Click on a player''s name to obtain a tile representing it.'
+  translated.!

Item was changed:
  ----- Method: AllPlayersTool>>initializeFor: (in category 'initialization') -----
  initializeFor: aPresenter
  	"Initialize the receiver as a tool which shows, and allows the user to change the status of, all the instantiations of all the user-written scripts in the scope of the containing pasteup's presenter"
  
  	| placeHolder |
  	self color: Color brown muchLighter muchLighter; wrapCentering: #center; cellPositioning: #topCenter; vResizing: #shrinkWrap; hResizing: #shrinkWrap.
  	self useRoundedCorners.
+ 	self layoutInset: 0.
  	self borderStyle: BorderStyle complexAltInset; borderWidth: 4; borderColor: (Color r: 0.452 g: 0.839 b: 1.0).  "Color fromUser"
  	self addHeaderRow.
+ 	placeHolder _ Morph new beTransparent.
+ 	placeHolder extent: 200 at 0.
- 	placeHolder := Morph new beTransparent.
- 	placeHolder extent: 200 at 1.
  	self addMorphBack: placeHolder.
+ 	self setProperty: #ExplicitStepTime toValue: 5000.  "5 seconds"
+ 	WorldState addDeferredUIMessage:
+ 		[self updateScrollbar.
+ 		self reinvigorate]
- 	ActiveWorld presenter reinvigoratePlayersTool: self 
  
  !

Item was added:
+ ----- Method: AllPlayersTool>>playersOnDisplay (in category '*Etoys-Squeakland-reinvigoration') -----
+ playersOnDisplay
+ 	"Answer a list of the players represented by the rows in the tool."
+ 
+ 	| aList |
+ 	(submorphs size < 3 or: [(submorphs third isKindOf: ScrollPane) not]) ifTrue: [^ #()].
+ 
+ 	aList := submorphs third scroller firstSubmorph submorphs collect:
+ 		[:aRow | aRow playerRepresented].
+ 	^ aList copyWithout: nil!

Item was changed:
  ----- Method: AllPlayersTool>>presentHelp (in category 'menus') -----
  presentHelp
  	"Sent when a Help button is hit; provide the user with some form of help for the tool at hand"
  
+ 	| aFlapTab aString |
+ 	aString _ '
+ Each row represents an object, or "player" in the project.
+ Click on the menu icon to get a menu of options concerning the player.
+ Click on a player''s picture to reveal its location.
+ Click on the turquoise eye to open the player''s viewer.
+ Click on a player''s name to obtain a tile representing it.'
+  translated.
- 	| aString aTextMorph |
- 	aString := 'About the Gallery of Players
  
+ 	aFlapTab := ScriptingSystem assureFlapOfLabel: 'Players' translated withContents: aString.
+ 	aFlapTab showFlap!
- Click on an object''s picture to reveal its location.
- Click on the turquoise eye to open the object''s viewer.
- Click on an object''s name to obtain a tile representing the object.   
- 
- Double-click on the title ("Gallery of Players") to refresh the tool;
- this may allow you to see newly-added or newly-scripted objects.'.
- 	aTextMorph :=  TextMorph new contents: aString translated.
- 	aTextMorph useRoundedCorners; borderWidth: 3; borderColor: Color gray; margins: 3 at 3.
- 	aTextMorph backgroundColor: Color blue muchLighter.
- 	aTextMorph beAllFont: (StrikeFont familyName: #ComicBold size: 18);
- 	 centered; lock.
- 	AlignmentMorph new beTransparent
- 		hResizing: #shrinkWrap;
- 		vResizing: #shrinkWrap;
- 		addMorphBack: aTextMorph;
- 		openInHand!

Item was added:
+ ----- Method: AllPlayersTool>>updateScrollbar (in category '*Etoys-Squeakland-initialization') -----
+ updateScrollbar
+ 	"Every subsystem needs a little bit of inscrutable magic"
+ 
+ 	self setExtentFromHalo: ((self extent x max:300) @ (self extent y max: 400))!

Item was changed:
  ----- Method: AllScriptsTool class>>defaultNameStemForInstances (in category 'printing') -----
  defaultNameStemForInstances
  	"Answer the default name stem for new instances of this class"
  
+ 	^ 'All Scripts' translatedNoop!
- 	^ 'All Scripts'!

Item was changed:
  ----- Method: AllScriptsTool class>>descriptionForPartsBin (in category 'parts bin') -----
  descriptionForPartsBin
  	"Answer a description for use in parts bins"
  
+ 	^ self partName: 	'All Scripts' translatedNoop
+ 		categories:		{'Scripting' translatedNoop}
+ 		documentation:	'A tool allowing you to monitor and change the status of all scripts in your project' translatedNoop!
- 	^ self partName: 	'All Scripts'
- 		categories:		#('Scripting')
- 		documentation:	'A tool allowing you to monitor and change the status of all scripts in your project'!

Item was changed:
  ----- Method: AllScriptsTool class>>registerInFlapsRegistry (in category 'class initialization') -----
  registerInFlapsRegistry
  	"Register the receiver in the system's flaps registry"
  	self environment
  		at: #Flaps
+ 		ifPresent: [:cl | cl registerQuad: {#AllScriptsTool. #allScriptsToolForActiveWorld.	'All Scripts' translatedNoop. 'A tool that lets you see and control all the running scripts in your project' translatedNoop}
- 		ifPresent: [:cl | cl registerQuad: #(AllScriptsTool			allScriptsToolForActiveWorld	'All Scripts' 		'A tool that lets you see and control all the running scripts in your project')
  						forFlapNamed: 'PlugIn Supplies'.
+ 						cl registerQuad: {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}
- 						cl registerQuad: #(AllScriptsTool			allScriptsToolForActiveWorld	'All Scripts' 		'A tool that lets you control all the running scripts in your world')
  						forFlapNamed: 'Scripting'.
+ 						cl registerQuad: {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you see and control all the running scripts in your project' translatedNoop}
- 						cl registerQuad: #(AllScriptsTool			allScriptsToolForActiveWorld	'All Scripts' 		'A tool that lets you see and control all the running scripts in your project')
  						forFlapNamed: 'Widgets']!

Item was changed:
  ----- Method: AllScriptsTool>>addSecondLineOfControls (in category 'initialization') -----
  addSecondLineOfControls
  	"Add the second line of controls"
  
  	| aRow outerButton aButton worldToUse |
+ 	aRow _ AlignmentMorph newRow listCentering: #center; color: Color transparent.
+ 	outerButton _ AlignmentMorph newRow.
- 	aRow := AlignmentMorph newRow listCentering: #center; color: Color transparent.
- 	outerButton := AlignmentMorph newRow.
  	outerButton wrapCentering: #center; cellPositioning: #leftCenter.
  	outerButton color:  Color transparent.
  	outerButton hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ 	outerButton addMorph: (aButton _ UpdatingThreePhaseButtonMorph checkBox).
- 	outerButton addMorph: (aButton := UpdatingThreePhaseButtonMorph checkBox).
  	aButton
  		target: self;
  		actionSelector: #toggleWhetherShowingOnlyActiveScripts;
  		getSelector: #showingOnlyActiveScripts.
  	outerButton addTransparentSpacerOfSize: (4 at 0).
+ 	outerButton addMorphBack: (StringMorph contents: 'tickers only' translated font: ScriptingSystem fontForEToyButtons) lock.
- 	outerButton addMorphBack: (StringMorph contents: 'tickers only' translated) lock.
  	outerButton setBalloonText: 'If checked, then only scripts that are paused or ticking will be shown' translated.
  	aRow addMorphBack: outerButton.
  
  	aRow addTransparentSpacerOfSize: 20 at 0.
  	aRow addMorphBack: self helpButton.
  
  	aRow addTransparentSpacerOfSize: 20 at 0.
  
+ 	outerButton _ AlignmentMorph newRow.
- 	outerButton := AlignmentMorph newRow.
  	outerButton wrapCentering: #center; cellPositioning: #leftCenter.
  	outerButton color:  Color transparent.
  	outerButton hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ 	outerButton addMorph: (aButton _ UpdatingThreePhaseButtonMorph checkBox).
- 	outerButton addMorph: (aButton := UpdatingThreePhaseButtonMorph checkBox).
  	aButton
  		target: self;
  		actionSelector: #toggleWhetherShowingAllInstances;
  		getSelector: #showingAllInstances.
  	outerButton addTransparentSpacerOfSize: (4 at 0).
+ 	outerButton addMorphBack: (StringMorph contents: 'all instances' translated font: ScriptingSystem fontForEToyButtons) lock.
- 	outerButton addMorphBack: (StringMorph contents: 'all instances' translated) lock.
  	outerButton setBalloonText: 'If checked, then entries for all instances will be shown, but if not checked, scripts for only one representative of each different kind of object will be shown.  Consult the help available by clicking on the purple ? for more information.' translated.
  	aRow addMorphBack: outerButton.
  
  	self addMorphBack: aRow.
+ 	worldToUse _ self isInWorld ifTrue: [self world] ifFalse: [ActiveWorld].
- 	worldToUse := self isInWorld ifTrue: [self world] ifFalse: [ActiveWorld].
  	worldToUse presenter reinvigorateAllScriptsTool: self.
  	self layoutChanged.!

Item was added:
+ ----- Method: AllScriptsTool>>helpString (in category '*Etoys-Squeakland-initialization') -----
+ helpString
+ 	"Answer the help string for the all-scripts tool."
+ 
+ 	^
+ 'This tool allows you to see all the scripts for all the objects in this project.
+ 
+ Sometimes you are only interested in those scripts that are ticking, or that are *ready* to tick when you hit the GO button (which are said to be "paused.")
+ 
+ * Check "tickers only" if you only want to see such scripts -- i.e., scripts that are either paused or ticking.
+ 
+ * If "tickers only" is *not* checked, then all scripts will be shown, whatever their status.
+ 
+ * The other checkbox, labeled "all instances", only comes into play if you have created "multiple sibling instances" (good grief) of the same object, which share the same scripts; if you have such things, it is often convenient to see the scripts of just *one* such sibling, because it will take up less space and require less mindshare -- and note that you can control a script for an object *and* all its siblings from the menu of that one that you see, via menu items such as "propagate status to siblings".
+ 
+ * If "all instances" is checked, scripts for all sibling instances will be shown, whereas if "all instances" is *not* checked, only one of each group of siblings will be selected to have its scripts shown.
+ 
+ But how do you get "multiple sibling instances" of the same object?  There are several ways:
+ 
+ (1)  Use the "make a sibling instance" or the "make multiple siblings..." menu item in the halo menu of a scripted object.
+ 
+ (2)  Use the "copy" tile in a script.
+ 
+ (3)  Request "give me a copy now" from the menu associated with the "copy" item in a Viewer.
+ 
+ If you have on your screen multiple sibling instances of the same object, then you may or may want to see them all in the All Scripts tool, and that is what the "all instances" checkbox governs.
+ 
+ Set "all instances" if you want a separate entry for each instance, as
+ opposed to a single representative of that kind of object.
+ 
+ Note that if you obtain a copy of an object by using the green halo handle, it will *not* be a sibling instance of the original.  It will in many ways seem to be, because it will start out its life having the same scripts as the original.  But it will then lead an independent life, so that changes to scripts of the original will not be reflected in it, and vice-versa.
+ 
+ This is an important distinction, and an unavoidable one because people sometimes want the deep sharing of sibling instances and sometimes they clearly do not.  But the truly understandable description of these concepts and distinctions certainly lies *ahead* of us!!' translated!

Item was changed:
  ----- Method: AllScriptsTool>>initializeFor: (in category 'initialization') -----
  initializeFor: ignored
  	"Initialize the receiver as a tool which shows, and allows the user to change the status of, all the instantiations of all the user-written scripts in the scope of the containing pasteup's presenter"
  
  	| aRow aButton |
+ 	showingOnlyActiveScripts _ true.
+ 	showingAllInstances _ true.
+ 	showingOnlyTopControls _ true.
- 	showingOnlyActiveScripts := true.
- 	showingAllInstances := true.
- 	showingOnlyTopControls := true.
  	self color: Color brown muchLighter muchLighter; wrapCentering: #center; cellPositioning: #topCenter; vResizing: #shrinkWrap; hResizing: #shrinkWrap.
  	self useRoundedCorners.
  	self borderWidth: 4; borderColor: Color brown darker.
+ 	aRow _ AlignmentMorph newRow.
- 	aRow := AlignmentMorph newRow.
  	aRow listCentering: #justified; color: Color transparent.
+ 	aButton _ self tanOButton.
- 	aButton := self tanOButton.
- 	aButton actionSelector: #delete.
  	aRow addMorphFront: aButton.
+ 	aRow addTransparentSpacerOfSize: 10.
  	aRow addMorphBack: ScriptingSystem scriptControlButtons.
+ 	aRow addTransparentSpacerOfSize: 10.
  	aRow addMorphBack: self openUpButton.
  	self addMorphFront: aRow.
  
  !

Item was changed:
  ----- Method: AllScriptsTool>>openUpButton (in category 'toggles') -----
  openUpButton
  	"Answer a button whose action would be to open up the receiver or snap it back closed"
  
+ 	| aButton |
+ 	aButton := UpdatingThreePhaseButtonMorph blackTriangularOpener.
+ 	aButton getSelector: #showingOnlyTopControls.
- 	| aButton aForm |
- 	aButton := IconicButton new borderWidth: 0.
- 	aForm := ScriptingSystem formAtKey: #PowderBlueOpener.
- 	aForm ifNil:
- 		[aForm := Form extent: 13 at 22 depth: 16 fromArray: #( 0 0 12017 787558129 0 0 0 0 12017 787561309 995965789 787558129 0 0 0 787561309 995965789 995965789 995965789 787546112 0 12017 995965789 995965789 995965789 995965789 995962609 0 12017 995965789 995965789 995965789 995965789 995962609 0 787561309 995965789 995965789 995965789 995965789 995965789 787546112 787561309 995965789 995965789 995965789 995965789 995965789 787546112 787561309 995965789 995950593 80733 995965789 995965789 787546112 787561309 995965789 65537 65537 80733 995965789 787546112 787561309 995950593 80733 995950593 80733 995965789 787546112 787561309 995950593 80733 995950593 80733 995965789 787546112 787561309 995950593 65537 65537 80733 995965789 787546112 787561309 995965789 65537 65537 995965789 995965789 787546112 787561309 995965789 995965789 995965789 995965789 995965789 787546112 787561309 995965789 995965789 995965789 995965789 995965789 787546112 787561309 995965789 995965789 995965789 995965789 995965789 787546112 787561309 995965789 995965789 995965789 995965789 995965789 787546112 12017 995965789 995965789 995965789 995965789 995962609 0 12017 995965789 995965789 995965789 995965789 995962609 0 0 787561309 995965789 995965789 995965789 787546112 0 0 12017 787561309 995965789 787558129 0 0 0 0 12017 787558129 0 0 0) offset: 0 at 0.
- 		ScriptingSystem saveForm: aForm atKey: #PowderBlueOpener].
- 	aButton labelGraphic: aForm.
  	aButton
  		target: self;
- 		color: Color transparent;
  		actionSelector: #toggleWhetherShowingOnlyTopControls;
  		setBalloonText: 'open or close the lower portion that shows individual scripts' translated.
  	^ aButton!

Item was changed:
  ----- Method: AllScriptsTool>>presentHelp (in category 'initialization') -----
  presentHelp
  	"Sent when a Help button is hit; provide the user with some form of help for the tool at hand"
  
+ 	| aFlapTab |
+ 	aFlapTab := ScriptingSystem assureFlapOfLabel: 'All Scripts' translated withContents: self helpString.
+ 	aFlapTab showFlap!
- 	| aString |
- 	aString := 
- 'This tool allows you to see all the scripts for all the objects in this project.
- 
- Sometimes you are only interested in those scripts that are ticking, or that are *ready* to tick when you hit the GO button (which are said to be "paused.")
- 
- Check "tickers only" if you only want to see such scripts -- i.e., scripts that are either paused or ticking.
- 
- If "tickers only" is *not* checked, then all scripts will be shown, whatever their status.
- 
- The other checkbox, labeled "all instances", only comes into play if you have created "multiple sibling instances" (good grief) of the same object, which share the same scripts; if you have such things, it is often convenient to see the scripts of just *one* such sibling, because it will take up less space and require less mindshare -- and note that you can control a script for an object *and* all its siblings from the menu of that one that you see, via menu items such as "propagate status to siblings".
- 
- If "all instances" is checked, scripts for all sibling instances will be shown, whereas if "all instances" is *not* checked, only one of each group of siblings will be selected to have its scripts shown.
- 
- But how do you get "multiple sibling instances" of the same object?  There are several ways:
- 
- (1)  Use the "make a sibling instance" or the "make multiple siblings..." menu item in the halo menu of a scripted object
- 
- (2)  Use the "copy" tile in a script.
- 
- (3)  Request "give me a copy now" from the menu associated with the "copy" item in a Viewer
- 
- If you have on your screen multiple sibling instances of the same object, then you may or may want to see them all in the All Scripts tool, and that is what the "all instances" checkbox governs.
- 
- Set "all instances" if you want a separate entry for each instance, as
- opposed to a single representative of that kind of object.
- 
- Note that if you obtain a copy of an object by using the green halo handle, it will *not* be a sibling instance of the original.  It will in many ways seem to be, because it will start out its life having the same scripts as the original.  But it will then lead an independent life, so that changes to scripts of the original will not be reflected in it, and vice-versa.
- 
- This is an important distinction, and an unavoidable one because people sometimes want the deep sharing of sibling instances and sometimes they clearly do not.  But the truly understandable description of these concepts and distinctions certainly lies *ahead* of us!!'.
- 
- 	(StringHolder new contents: aString translated)
- 		openLabel: 'About the All Scripts tool' translated!

Item was added:
+ ----- Method: AnimatedImageMorph>>fromArray: (in category '*Etoys-Squeakland-private') -----
+ fromArray: reader 
+ 	images := reader first.
+ 	delays := reader second.
+ 	imageIndex := 0.
+ 	self
+ 		image: (Form extent: images first extent depth: 32).
+ 	self isOpaque: true.
+ 	self step!

Item was added:
+ ----- Method: AnimatedImageMorph>>setStepping: (in category '*Etoys-Squeakland-stepping and presenter') -----
+ setStepping: aBoolean
+ self wantsSteps ifFalse:[^false].
+ stepper := aBoolean.
+ stepper ifTrue:[self startStepping]
+ 				ifFalse:[self stopStepping].
+ 	
+     !

Item was added:
+ ----- Method: AnimatedImageMorph>>steppingString (in category '*Etoys-Squeakland-stepping and presenter') -----
+ steppingString
+ 	^ (stepper
+ 		ifTrue: ['<on>']
+ 		ifFalse: ['<off>']), 'stepping' translated!

Item was added:
+ ----- Method: AnimatedImageMorph>>toggleStepping (in category '*Etoys-Squeakland-stepping and presenter') -----
+ toggleStepping
+ 	self wantsSteps
+ 		ifTrue: [stepper := stepper not].
+ 	stepper ifTrue:[self startStepping]
+ 				ifFalse:[self stopStepping].
+ 	
+     !

Item was added:
+ AbstractMediaEventMorph subclass: #AnonymousSoundMorph
+ 	instanceVariableNames: 'sound interimName'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sound-Interface'!
+ 
+ !AnonymousSoundMorph commentStamp: 'sw 10/19/2007 16:56' prior: 0!
+ Holds a free-standing sound, i.e. one not associated with the system's sound library.
+ Can be played by hitting Play button, and can stop its playing by hitting Stop.
+ Can be dropped into a piano roll or into an event roll
+ Can also be named and added to the system sound library, by hitting the save button.!

Item was added:
+ ----- Method: AnonymousSoundMorph class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') -----
+ fileReaderServicesForFile: fullName suffix: suffix 
+ 	"Answer the file services associated with given file"
+ 
+ 	^ (self registeredAudioFileSuffixes includes: suffix)
+ 		ifTrue: [self services]
+ 		ifFalse: [#()]!

Item was added:
+ ----- Method: AnonymousSoundMorph class>>fromFileName: (in category 'fileIn/Out') -----
+ fromFileName: fullName
+ 	"Create an instance of the receiver from the given file path."
+ 	
+ 	| newPlayer aSound ext aName |
+ 	newPlayer _ self new initialize.
+ 	('*aif*' match: fullName) 
+ 		ifTrue: [aSound := SampledSound fromAIFFfileNamed: fullName].
+ 	('*wav' match: fullName) 
+ 		ifTrue: [aSound := SampledSound fromWaveFileNamed: fullName].
+ 	newPlayer := self new.
+ 
+ 	ext := FileDirectory extensionFor: fullName.
+ 	aName :=  (FileDirectory on: fullName) pathParts last.
+ 	ext size > 0 ifTrue:
+ 		[aName := aName copyFrom: 1 to: (aName size - (ext size + 1))].
+ 	
+ 	newPlayer sound: aSound interimName: aName.
+ 
+ 	newPlayer openInWorld; position: ActiveWorld center!

Item was added:
+ ----- Method: AnonymousSoundMorph class>>registeredAudioFileSuffixes (in category 'file suffixes') -----
+ registeredAudioFileSuffixes
+     "Answer the file extensions for which the receiver registers audio services with FileList."
+      "AnonymousSoundMorph registeredAudioFileSuffixes"
+ 
+      ^ { 'aif'. 'aiff'.  'wav'}!

Item was added:
+ ----- Method: AnonymousSoundMorph>>addButtonRow (in category 'initialization') -----
+ addButtonRow
+ 	"Add the row of control buttons."
+ 
+ 	| row button |
+ 	row := AlignmentMorph newRow vResizing: #shrinkWrap;
+ 				 color: Color transparent.
+ 	row addVariableTransparentSpacer.
+ 	button := SimpleButtonMorph new label: 'Play' translated font: ScriptingSystem fontForEToyButtons;
+ 				 target: self;
+ 				 actionSelector: #playSound.
+ 	row addMorphBack: button.
+ 	row addVariableTransparentSpacer.
+ 	button := SimpleButtonMorph new label: 'Stop' translated font: ScriptingSystem fontForEToyButtons;
+ 				 target: self;
+ 				 actionSelector: #stopSound.
+ 	row addMorphBack: button.
+ 	row addVariableTransparentSpacer.
+ 
+ 	button := SimpleButtonMorph new label: 'Save' translated font: ScriptingSystem fontForEToyButtons;
+ 				 target: self;
+ 				 actionSelector: #addToSoundLibrary .
+ 	row addMorphBack: button.
+ 	row addVariableTransparentSpacer.
+ 	self addMorphBack: row!

Item was added:
+ ----- Method: AnonymousSoundMorph>>addCustomMenuItems:hand: (in category 'menu') -----
+ addCustomMenuItems: aMenu hand: aHandMorph
+ 	"Add morph-specific items to the given menu which was invoked by the given hand.  This method provides is invoked both from the halo-menu and from the control-menu regimes."
+ 
+ 	super addCustomMenuItems: aMenu hand: aHandMorph.
+ 
+ 	aMenu addTranslatedList: #(
+ 		-
+ 		('wave editor' openWaveEditorOnSound 'open a wave-editor tool with this sound as its iniital sound')) translatedNoop!

Item was added:
+ ----- Method: AnonymousSoundMorph>>addMorphsTo:pianoRoll:eventTime:betweenTime:and: (in category 'piano roll') -----
+ addMorphsTo: morphList pianoRoll: pianoRoll eventTime: t betweenTime: leftTime and: rightTime
+ 	"Custom piano-roll processing.  Consult my sender for more info."
+ 
+ 	| startX lengthInTicks endX |
+ 	startTimeInScore > rightTime ifTrue: [^ self].  
+ 	lengthInTicks _ pianoRoll scorePlayer ticksForMSecs: sound duration * 1000.0.
+ 	startTimeInScore + lengthInTicks < leftTime ifTrue: [^ self].
+ 	startX _ pianoRoll xForTime: startTimeInScore.
+ 	endX _ pianoRoll xForTime: startTimeInScore + lengthInTicks.
+ 	morphList add: 
+ 		(self left: startX; width: endX - startX).
+ 
+ !

Item was added:
+ ----- Method: AnonymousSoundMorph>>addToSoundLibrary (in category 'menu') -----
+ addToSoundLibrary
+ 	"Add the receiver's sound to the library, and hand the user a tile representing it."
+ 
+ 	| aName tile |
+ 	aName := FillInTheBlank request: 'kindly give the sound a name: ' translated initialAnswer: (interimName ifNil: ['']).
+ 	aName isEmptyOrNil ifTrue: [^ self].
+ 
+ 	aName := SampledSound unusedSoundNameLike:  aName.
+ 
+ 	SampledSound
+ 			addLibrarySoundNamed: aName
+ 			samples: sound samples
+ 			samplingRate: sound originalSamplingRate.
+ 	tile _ SoundTile new literal: aName.
+ 	tile bounds: tile fullBounds.
+ 	tile center: self fullBoundsInWorld center.
+ 	(ScriptingTileHolder around: tile) center:  self fullBoundsInWorld center;
+ 		openInWorld.
+ 	
+ 	self delete!

Item was added:
+ ----- Method: AnonymousSoundMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color lightGreen!

Item was added:
+ ----- Method: AnonymousSoundMorph>>encounteredAtTime:inScorePlayer:atIndex:inEventTrack:secsPerTick: (in category 'piano roll') -----
+ encounteredAtTime: ticks inScorePlayer: scorePlayer atIndex: index inEventTrack: track secsPerTick: secsPerTick
+ 
+ 	"hack... since we are called from within the SoundPlayer loop, the Semaphore will
+ 	block attempts to play directly from here"
+ 	WorldState addDeferredUIMessage: [sound play].!

Item was added:
+ ----- Method: AnonymousSoundMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 
+ 	super initialize.
+ 	self height: 18.
+ 
+ 	self balloonTextSelector: #soundMorphHelpString.
+ 	self on: #doubleClick send: #playSound to: self.
+ 	self on: #mouseMove send: #openInHand to: self.
+ 	self on: #click send: #stopSound to: self.
+ 
+ 	interimName := SampledSound unusedSoundNameLike: 'Unnamed' translated!

Item was added:
+ ----- Method: AnonymousSoundMorph>>justDroppedInto:event: (in category 'piano roll') -----
+ justDroppedInto: aMorph event: evt
+ 	"The receiver was just dropped into some container... respond accordingly."
+ 
+ 	super justDroppedInto: aMorph event: evt.
+ 	(aMorph isKindOf: PianoRollScoreMorph ) ifTrue: [^ self].
+ 	submorphs size < 2 ifTrue:
+ 		[self sound: sound interimName: interimName]!

Item was added:
+ ----- Method: AnonymousSoundMorph>>justDroppedIntoPianoRoll:event: (in category 'piano roll') -----
+ justDroppedIntoPianoRoll: newOwner event: evt
+ 	"The receiver was just dropped into a piano roll... respond accordingly."
+ 
+ 	| startX lengthInTicks endX |
+ 	super justDroppedIntoPianoRoll: newOwner event: evt.
+ 	submorphs size > 1 ifTrue: [submorphs last delete].
+ 	self hResizing: #rigid; clipSubmorphs: true.
+ 
+ 	startTimeInScore _ newOwner timeForX: self left.
+ 	lengthInTicks _ newOwner scorePlayer ticksForMSecs: sound duration * 1000.0.
+ 	endTimeInScore _ startTimeInScore + lengthInTicks.
+ 
+ 	endTimeInScore > newOwner scorePlayer durationInTicks ifTrue:
+ 		[newOwner scorePlayer updateDuration].
+ 
+ 	startX _ newOwner xForTime: startTimeInScore.
+ 	endX _ newOwner xForTime: endTimeInScore.
+ 	self width: endX - startX!

Item was added:
+ ----- Method: AnonymousSoundMorph>>openWaveEditorOnSound (in category 'menu') -----
+ openWaveEditorOnSound
+ 	"Open a wave-editor tool on the receiver's sound"
+ 
+ 	WaveEditor openOn: sound samples!

Item was added:
+ ----- Method: AnonymousSoundMorph>>playSound (in category 'menu') -----
+ playSound
+ 	"Play the receiver's sound."
+ 
+ 	sound play!

Item was added:
+ ----- Method: AnonymousSoundMorph>>putEventsOnto: (in category 'event roll') -----
+ putEventsOnto: aStream
+ 	"Write all of the events represented by the receiver in its current state onto the given stream."
+ 
+ 	| aNewEvent |
+ 	aNewEvent :=  MediaPlayEvent new.
+ 	aNewEvent setType: #startSound argument: self sound hand: nil stamp: (self eventRoll timeStampForCurrentPositionOf: self).
+ 	aStream nextPut: aNewEvent!

Item was added:
+ ----- Method: AnonymousSoundMorph>>releaseCachedState (in category 'caching') -----
+ releaseCachedState
+ 	"If the sound is not currently compressed, compress it with the GSM codec"
+ 
+ 	super releaseCachedState.
+ 	sound isCompressed
+ 		ifFalse: [sound _ sound compressWith: GSMCodec].
+ !

Item was added:
+ ----- Method: AnonymousSoundMorph>>sound (in category 'accessing') -----
+ sound
+ 	"Answer the sound."
+ 
+ 	^ sound!

Item was added:
+ ----- Method: AnonymousSoundMorph>>sound:interimName: (in category 'initialization') -----
+ sound: aSampledSound interimName: anInterimName
+ 	"Establish the sound object and an interim name."
+ 
+ 	| aStringMorph |
+ 	self removeAllMorphs.
+ 	self hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ 	borderWidth _ 2.
+ 	self listDirection: #topToBottom.
+ 	sound := aSampledSound.
+ 	interimName := anInterimName.
+ 
+ 	aStringMorph := StringMorph contents: interimName font: ScriptingSystem fontForEToyButtons.
+ 	self addMorphBack: aStringMorph.
+ 	self addButtonRow.
+ 
+ 	self balloonTextSelector: #soundMorphHelpString.
+ 	self setNameTo: interimName!

Item was added:
+ ----- Method: AnonymousSoundMorph>>soundMorphHelpString (in category 'initialization') -----
+ soundMorphHelpString
+ 	"Answer a string represnting the ballon text for the receiver."
+ 
+ 	^ 'Holds a recorded sound of duration ' translated, (sound duration printShowingDecimalPlaces: 3),' seconds.
+ Double-click to hear the sound.  "add to sound library" available in halo menu.  Also suitable for dropping into a piano-roll or into an event-roll' translated!

Item was added:
+ ----- Method: AnonymousSoundMorph>>stopPlayingSound (in category 'menu') -----
+ stopPlayingSound
+ 	"If the receiver's sound is playing, stop it."
+ 
+ 	sound pause!

Item was added:
+ ----- Method: AnonymousSoundMorph>>stopSound (in category 'menu') -----
+ stopSound
+ 	"Stop the receiver's sound from playing."
+ 
+ 	sound pause!

Item was added:
+ ----- Method: AnonymousSoundMorph>>suitableForDroppingIntoEventRoll (in category 'event roll') -----
+ suitableForDroppingIntoEventRoll
+ 	"Answer whether the receiver is suitable for dropping into an Event Roll."
+ 
+ 	^ true!

Item was added:
+ ----- Method: Array>>hashMappedBy: (in category '*Etoys-Squeakland-comparing') -----
+ hashMappedBy: map
+ 	"Answer what my hash would be if oops changed according to map."
+ 
+ 	self size = 0 ifTrue: [^self hash].
+ 	^(self first hashMappedBy: map) + (self last hashMappedBy: map)!

Item was added:
+ ----- Method: Array>>literalStringsDo: (in category '*Etoys-Squeakland-translating') -----
+ literalStringsDo: aBlock 
+ 	"Assuming the receiver receiver is a literal, evaluate aBlock with all Strings (but not Symbols) within it."
+ 	self do: [:each | each literalStringsDo: aBlock]!

Item was added:
+ ----- Method: Array>>translatedNoop (in category '*Etoys-Squeakland-translating') -----
+ translatedNoop
+ 	"This is correspondence gettext_noop() in gettext."
+ 	^ self!

Item was added:
+ ----- Method: AssignmentNode>>assignmentMsgType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ assignmentMsgType
+ 	^ #assignment!

Item was added:
+ ----- Method: AssignmentNode>>defaultBlockType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultBlockType: t1 
+ 	^ #default!

Item was added:
+ ----- Method: AssignmentNode>>defaultMessageType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultMessageType
+ 	^ #none!

Item was added:
+ ----- Method: AssignmentNode>>firstInReceivers: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ firstInReceivers: t1 
+ 	^ t1 first!

Item was added:
+ ----- Method: AssignmentNode>>getAllChildren (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getAllChildren
+ 
+ 	^ Array with: variable with: value.
+ !

Item was added:
+ ----- Method: AssignmentNode>>getElderSiblingOf: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getElderSiblingOf: node
+ 
+ 	node = value ifTrue: [^ variable].
+ 	^ nil.
+ !

Item was added:
+ ----- Method: AssignmentNode>>getFirstChild (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getFirstChild
+ 
+ 	^ variable.
+ !

Item was added:
+ ----- Method: AssignmentNode>>getLastChild (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getLastChild
+ 
+ 	^ value.
+ !

Item was added:
+ ----- Method: AssignmentNode>>isFirstChild: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isFirstChild: childNode
+ 
+ 	^ childNode = variable.
+ !

Item was added:
+ ----- Method: AssignmentNode>>isLastChild: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isLastChild: childNode
+ 
+ 	^ childNode = value.
+ !

Item was added:
+ ----- Method: AssignmentNode>>isStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isStmt: t1 
+ 	^ t1 = #top
+ 		or: [t1 = #condition]!

Item was added:
+ ----- Method: AssignmentNode>>isTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTest: t1 parentNode: t2 
+ 	t1 = true
+ 		ifTrue: [^ true].
+ 	^ (t2 isMemberOf: MessageNode)
+ 		and: [t2 receiver = self
+ 				and: [t2 messageType value = #condition]]!

Item was added:
+ ----- Method: AssignmentNode>>isTopStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmt: t1 
+ 	t1 = nil
+ 		ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: AssignmentNode>>rcvr: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr: t1 
+ 	^ t1!

Item was added:
+ ----- Method: AssignmentNode>>replaceNode:with: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ replaceNode: childNode with: newNode
+ 
+ 	childNode = variable ifTrue: [variable _ newNode. ^ self].
+ 	childNode = value ifTrue: [value _ newNode. ^ self].
+ !

Item was added:
+ ----- Method: AssignmentNode>>sizeForEffect: (in category '*Etoys-Squeakland-code generation') -----
+ sizeForEffect: encoder
+ 
+ 	^(value sizeForValue: encoder)
+ 		+ (variable sizeForStorePop: encoder)!

Item was added:
+ ----- Method: AssignmentNode>>sizeForValue: (in category '*Etoys-Squeakland-code generation') -----
+ sizeForValue: encoder
+ 
+ 	^(value sizeForValue: encoder)
+ 		+ (variable sizeForStore: encoder)!

Item was added:
+ ----- Method: AssignmentNode>>thisNode (in category '*Etoys-Tweak-Kedama-Generated') -----
+ thisNode
+ 	^ self!

Item was added:
+ ----- Method: AssignmentNode>>transfer: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 
+ 	^ t1!

Item was added:
+ ----- Method: AssignmentNode>>visitBy: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ visitBy: visitor
+ 
+ 	visitor visit: self.
+ 	variable visitBy: visitor.
+ 	value visitBy: visitor.
+ !

Item was added:
+ ----- Method: AssignmentTileMorph>>assignmentRootForParseNode (in category '*Etoys-Squeakland-player viewer') -----
+ assignmentRootForParseNode
+ 	"Answer the assignment root"
+ 
+ 	^ Utilities setterSelectorFor: assignmentRoot!

Item was added:
+ ----- Method: AssignmentTileMorph>>assignmentSuffix (in category '*Etoys-Squeakland-accessing') -----
+ assignmentSuffix
+ 
+ 	^ assignmentSuffix.
+ !

Item was added:
+ ----- Method: AssignmentTileMorph>>operatorForSexpAssignmentSuffix: (in category '*Etoys-Squeakland-code generation') -----
+ operatorForSexpAssignmentSuffix: aString
+ 	"Answer the operator associated with the receiver, assumed to be one of the compound assignments"
+ 
+ 	| toTest |
+ 	toTest _ aString asString.
+ 	#(	('Incr:'				#Incr:)
+ 		('Decr:'				#Decr:)
+ 		('Mult:'				#Mult:)
+ 		(':'				''))
+ 	do:
+ 		[:pair | toTest = pair first ifTrue: [^ pair second]].
+ 	^ toTest
+ 
+ 	"AssignmentTileMorph new operatorForTreeAssignmentSuffix: 'Incr:'"!

Item was added:
+ ----- Method: AssignmentTileMorph>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') -----
+ parseNodeWith: encoder
+ 
+ 	self error: 'error'.
+ 
+ !

Item was added:
+ ----- Method: AssignmentTileMorph>>sexpWith: (in category '*Etoys-Squeakland-code generation') -----
+ sexpWith: dictionary
+ 
+ 	self error: 'error'.
+ 
+ !

Item was added:
+ ----- Method: AsyncFile>>readChar (in category '*Etoys-Squeakland-sugar') -----
+ readChar
+ 	"Read one char. Might block."
+ 	^(self readChars: 1) first
+ !

Item was added:
+ ----- Method: AsyncFile>>readChars: (in category '*Etoys-Squeakland-sugar') -----
+ readChars: count
+ 	"Read count chars. Might block."
+ 
+ 	| buffer n |
+ 	fileHandle ifNil: [^ self error: 'file closed'].
+ 	buffer := String new: count.
+ 	self primReadStart: fileHandle fPosition: -1 count: buffer size.
+ 	[	semaphore wait.
+ 		n := self primReadResult: fileHandle intoBuffer: buffer at: 1 count: buffer size.
+ 		n = Busy.
+ 	] whileTrue.  "loop while busy in case the semaphore had excess signals"
+ 	n = Error ifTrue: [^ self error: 'asynchronous read operation failed'].
+ 	^buffer!

Item was added:
+ Object subclass: #AttributeSemanticRule
+ 	instanceVariableNames: 'inputSpecs output selector ruleText'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tweak-Kedama-ParseTreeTransformer'!

Item was added:
+ ----- Method: AttributeSemanticRule>>inputSpecs (in category 'all') -----
+ inputSpecs
+ 
+ 	^ inputSpecs.
+ !

Item was added:
+ ----- Method: AttributeSemanticRule>>inputSpecs: (in category 'all') -----
+ inputSpecs: inputs
+ 
+ 	inputSpecs _ inputs.
+ !

Item was added:
+ ----- Method: AttributeSemanticRule>>output (in category 'all') -----
+ output
+ 
+ 	^ output.
+ !

Item was added:
+ ----- Method: AttributeSemanticRule>>output: (in category 'all') -----
+ output: attr
+ 
+ 	output _ attr.
+ !

Item was added:
+ ----- Method: AttributeSemanticRule>>printOn: (in category 'all') -----
+ printOn: aStream
+ 
+ 	aStream nextPutAll: 'Rule(';
+ 		nextPutAll: output grammarClass name; 
+ 		nextPut: $.;
+ 		nextPutAll: output attributeName;
+ 		nextPutAll: ' _ ';
+ 		nextPutAll: (selector ifNil: ['nil']);
+ 		nextPut: $(.
+ 	inputSpecs do: [:in |
+ 		in printOn: aStream
+ 	].
+ 	aStream nextPutAll: '))'.
+ !

Item was added:
+ ----- Method: AttributeSemanticRule>>ruleText (in category 'all') -----
+ ruleText
+ 
+ 	^ ruleText.
+ !

Item was added:
+ ----- Method: AttributeSemanticRule>>ruleText: (in category 'all') -----
+ ruleText: text
+ 
+ 	ruleText _ text.
+ !

Item was added:
+ ----- Method: AttributeSemanticRule>>selector (in category 'all') -----
+ selector
+ 
+ 	^ selector.
+ !

Item was added:
+ ----- Method: AttributeSemanticRule>>selector: (in category 'all') -----
+ selector: aSymbol
+ 
+ 	selector _ aSymbol.
+ 
+ !

Item was added:
+ ----- Method: AttributeSemanticRule>>shouldBundleArgs (in category 'all') -----
+ shouldBundleArgs
+ 
+ 	^ inputSpecs size = 1 and: [inputSpecs first type = #allChildrenSynth].
+ !

Item was added:
+ Object subclass: #AttributeVisitor
+ 	instanceVariableNames: 'tree attributes evaluator allOccurences'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tweak-Kedama-ParseTreeTransformer'!

Item was added:
+ ----- Method: AttributeVisitor>>allOccurences (in category 'all') -----
+ allOccurences
+ 
+ 	^ allOccurences.
+ !

Item was added:
+ ----- Method: AttributeVisitor>>newWith:for: (in category 'all') -----
+ newWith: aParseTree for: anEvaluator
+ 
+ 	attributes _ IdentityDictionary new.
+ 	allOccurences _ WriteStream on: (Array new: 1000).
+ 	tree _ aParseTree.
+ 	evaluator _ anEvaluator.
+ 	tree visitBy: self.
+ !

Item was added:
+ ----- Method: AttributeVisitor>>occurencesForAttribute: (in category 'debugging') -----
+ occurencesForAttribute: attrName
+ 
+ 	^ allOccurences contents select: [:e | e attributeName = attrName].
+ !

Item was added:
+ ----- Method: AttributeVisitor>>occurencesForNode: (in category 'debugging') -----
+ occurencesForNode: aParseNode
+ 
+ 	^ allOccurences contents select: [:e | e node = aParseNode].
+ !

Item was added:
+ ----- Method: AttributeVisitor>>occurencesForNodeClass: (in category 'debugging') -----
+ occurencesForNodeClass: aParseNodeClass
+ 
+ 	^ allOccurences contents select: [:e | e node class = aParseNodeClass].
+ !

Item was added:
+ ----- Method: AttributeVisitor>>tree (in category 'all') -----
+ tree
+ 
+ 	^ tree.
+ !

Item was added:
+ ----- Method: AttributeVisitor>>visit: (in category 'all') -----
+ visit: node
+ 
+ 	| defs occurence ocs |
+ 	defs _ evaluator attributeDefinitionsOf: node class.
+ 	ocs _ OrderedCollection new.
+ 	defs do: [:def |
+ 		occurence _ ParseNodeAttributeOccurence new
+ 			attributeName: def attributeName;
+ 			rawGetter: def rawGetter;
+ 			setter: def setter;
+ 			grammarClass: node class;
+ 			addRules: def rules;
+ 			type: def type;
+ 			node: node.
+ 		node perform: def setter with: occurence.
+ 		ocs add: occurence.
+ 		allOccurences nextPut: occurence.
+ 	].
+ 	node xxxOccurences: ocs.!

Item was added:
+ ----- Method: BalloonBezierSimulation>>printOnStream: (in category '*Etoys-Squeakland-private') -----
+ printOnStream: aStream
+ 	aStream 
+ 		print: self class name;
+ 		print:'(';
+ 		write: start;
+ 		print:' - ';
+ 		write: via;
+ 		print:' - ';
+ 		write: end;
+ 		print:')'.!

Item was added:
+ ----- Method: BalloonBuffer class>>mew: (in category '*Etoys-Squeakland-instance creation') -----
+ mew: n
+ 	^self new: (n max: 256)!

Item was added:
+ ----- Method: BalloonLineSimulation>>printOnStream: (in category '*Etoys-Squeakland-printing') -----
+ printOnStream: aStream
+ 	aStream 
+ 		print: self class name;
+ 		print:'(';
+ 		write: start;
+ 		print:' - ';
+ 		write: end;
+ 		print:')'.!

Item was added:
+ ----- Method: BalloonMorph class>>getBestLocation:for:corner:force: (in category '*Etoys-Squeakland-private') -----
+ getBestLocation: vertices for: morph corner: cornerName force: forceFlag
+ 	"Try four rel locations of the balloon for greatest unclipped area.   12/99 sma"
+ 
+ 	| rect maxArea verts rectCorner morphPoint mbc a mp dir bestVerts result usableArea |
+ 	rect _ vertices first rect: (vertices at: 5).
+ 	maxArea _ -1.
+ 	verts _ vertices.
+ 	usableArea _ (morph world ifNil: [self currentWorld]) viewBox.
+ 	1 to: 4 do: [:i |
+ 		dir _ #(vertical horizontal) atWrap: i.
+ 		verts _ verts collect: [:p | p flipBy: dir centerAt: rect center].
+ 		rectCorner _ #(bottomLeft bottomRight topRight topLeft) at: i.
+ 		morphPoint _ #(topCenter topCenter bottomCenter bottomCenter) at: i.
+ 		a _ ((rect
+ 			align: (rect perform: rectCorner)
+ 			with: (mbc _ morph boundsForBalloon perform: morphPoint))
+ 				intersect: usableArea) area.
+ 		((forceFlag and: [rectCorner = cornerName]) or: [
+ 			(a > maxArea or: [a = rect area and: [rectCorner = cornerName]])]) ifTrue:
+ 			[maxArea _ a.
+ 			bestVerts _ verts.
+ 			mp _ mbc].
+ 		(forceFlag and: [rectCorner = cornerName]) ifTrue: [
+ 			^ bestVerts collect: [:p | p + (mp - bestVerts first)] "Inlined align:with:".
+ 		]].
+ 	result _ bestVerts collect: [:p | p + (mp - bestVerts first)] "Inlined align:with:".
+ 	^ result!

Item was added:
+ ----- Method: BalloonMorph class>>string:for:corner:force: (in category '*Etoys-Squeakland-instance creation') -----
+ string: str for: morph corner: cornerName force: forceFlag
+ 	"Make up and return a balloon for morph. Find the quadrant that 
+ 	clips the text the least, using cornerName as a tie-breaker. tk 9/12/97"
+ 	| tm vertices |
+ 	tm _ self getTextMorph: str for: morph.
+ 	vertices _ self getVertices: tm bounds.
+ 	vertices _ self
+ 				getBestLocation: vertices
+ 				for: morph
+ 				corner: cornerName
+ 				force: forceFlag.
+ 	^ self new color: morph balloonColor;
+ 		 setVertices: vertices;
+ 		 addMorph: tm;
+ 		 setTarget: morph!

Item was added:
+ RectangleMorph subclass: #BalloonRectangleMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Balloon-Geometry'!
+ 
+ !BalloonRectangleMorph commentStamp: '<historical>' prior: 0!
+ BalloonRectangleMorph is an example for drawing using the BalloonEngine.!

Item was added:
+ ----- Method: BalloonRectangleMorph>>canDrawBorder: (in category 'testing') -----
+ canDrawBorder: aBorderStyle
+ 	^aBorderStyle style == #simple!

Item was added:
+ ----- Method: BalloonRectangleMorph>>defaultBorderColor (in category 'initialization') -----
+ defaultBorderColor
+ 	"answer the default border color/fill style for the receiver"
+ 	^ GradientFillStyle ramp: {0.0 -> Color black. 1.0 -> Color white}!

Item was added:
+ ----- Method: BalloonRectangleMorph>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ 	"answer the default border width for the receiver"
+ 	^ 10!

Item was added:
+ ----- Method: BalloonRectangleMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	| result |
+ 	result _ GradientFillStyle ramp: {0.0 -> Color green. 0.5 -> Color yellow. 1.0 -> Color red}.
+ 	result radial: true.
+ 	^ result!

Item was added:
+ ----- Method: BalloonRectangleMorph>>doesBevels (in category 'accessing') -----
+ doesBevels
+ 	"To return true means that this object can show bevelled borders, and
+ 	therefore can accept, eg, #raised or #inset as valid borderColors.
+ 	Must be overridden by subclasses that do not support bevelled borders."
+ 
+ 	^ false!

Item was added:
+ ----- Method: BalloonRectangleMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 	(color isKindOf: OrientedFillStyle) ifTrue:[
+ 		color origin: bounds center.
+ 		color direction: (bounds extent x * 0.7) @ 0.
+ 		color normal: 0@(bounds extent y * 0.7).
+ 	].
+ 	(borderColor isKindOf: OrientedFillStyle) ifTrue:[
+ 		borderColor origin: bounds topLeft.
+ 		borderColor direction: (bounds extent x) @ 0.
+ 		borderColor normal: 0@(bounds extent y).
+ 	].
+ 	aCanvas asBalloonCanvas
+ 		drawRectangle: (bounds insetBy: borderWidth // 2)
+ 		color: color
+ 		borderWidth: borderWidth
+ 		borderColor: borderColor.!

Item was added:
+ ----- Method: BalloonRectangleMorph>>initialize (in category 'initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ 	super initialize.
+ ""
+ 	self extent: 100 @ 100!

Item was added:
+ ----- Method: BalloonRectangleMorph>>newTransformationMorph (in category 'rotate scale and flex') -----
+ newTransformationMorph
+ 	^MatrixTransformMorph new!

Item was added:
+ ----- Method: Behavior>>basicCompile:notifying:trailer:ifFail:for: (in category '*Etoys-Squeakland-private') -----
+ basicCompile: code notifying: requestor trailer: bytes ifFail: failBlock for: anInstance
+ 	"Compile code without logging the source in the changes file"
+ 
+ 	| methodNode |
+ 	methodNode _ self compilerClass new
+ 				compile: code
+ 				in: self
+ 				notifying: requestor
+ 				ifFail: failBlock for: anInstance.
+ 	methodNode encoder requestor: requestor.
+ 	^ CompiledMethodWithNode generateMethodFromNode: methodNode trailer: bytes.!

Item was added:
+ ----- Method: Behavior>>indexIfCompact (in category '*Etoys-Squeakland-private') -----
+ indexIfCompact
+ 	"If these 5 bits are non-zero, then instances of this class
+ 	will be compact.  It is crucial that there be an entry in
+ 	Smalltalk compactClassesArray for any class so optimized.
+ 	See the msgs becomeCompact and becomeUncompact."
+ 	^ (format bitShift: -11) bitAnd: 16r1F
+ "
+ Smalltalk compactClassesArray doWithIndex: 
+ 	[:c :i | c == nil ifFalse:
+ 		[c indexIfCompact = i ifFalse: [self halt]]]
+ "!

Item was added:
+ ----- Method: Behavior>>selectorAtMethod:setClass: (in category '*Etoys-Squeakland-private') -----
+ selectorAtMethod: method setClass: classResultBlock 
+ 	"Answer both the message selector associated with the compiled method 
+ 	and the class in which that selector is defined."
+ 
+ 	| sel |
+ 	sel _ self methodDict keyAtIdentityValue: method
+ 				ifAbsent: 
+ 					[superclass == nil
+ 						ifTrue: 
+ 							[classResultBlock value: self.
+ 							^method defaultSelector].
+ 					sel _ superclass selectorAtMethod: method setClass: classResultBlock.
+ 					"Set class to be self, rather than that returned from 
+ 					superclass. "
+ 					sel == method defaultSelector ifTrue: [classResultBlock value: self].
+ 					^sel].
+ 	classResultBlock value: self.
+ 	^sel!

Item was added:
+ ----- Method: Bezier2Segment>>printOnStream: (in category '*Etoys-Squeakland-printing') -----
+ printOnStream: aStream
+ 	aStream 
+ 		print: self class name;
+ 		print:'from: ';
+ 		write: start;
+ 		print:'via: ';
+ 		write: via;
+ 		print:'to: ';
+ 		write: end;
+ 		print:' '.!

Item was added:
+ ----- Method: BitEditor class>>locateMagnifiedView:scale: (in category '*Etoys-Squeakland-private') -----
+ locateMagnifiedView: aForm scale: scaleFactor
+ 	"Answer a rectangle at the location where the scaled view of the form,
+ 	aForm, should be displayed."
+ 
+ 	^ Rectangle originFromUser: (aForm extent * scaleFactor + (0 at 50)).
+ 	!

Item was added:
+ ----- Method: BlockNode>>blockRewriteInfo:statementType:primaryBreedPair: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ blockRewriteInfo: t1 statementType: t2 primaryBreedPair: t3 
+ 	(#(#parallel #sequential #die ) includes: t2)
+ 		ifFalse: [^ t1].
+ 	t3
+ 		ifNil: [^ t1].
+ 	^ Array with: t3 first with: 'var' , t3 first identityHash printString , self identityHash printString!

Item was added:
+ ----- Method: BlockNode>>blockType:parentMessageType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ blockType: t1 parentMessageType: t2 
+ 	t1 = #none
+ 		ifTrue: [^ #top].
+ 	t2 = #condition
+ 		ifTrue: [^ #condition].
+ 	t2 = #sequential
+ 		ifTrue: [^ #sequential].
+ 	^ #default!

Item was added:
+ ----- Method: BlockNode>>canBeSpecialArgument (in category '*Etoys-Squeakland-testing') -----
+ canBeSpecialArgument
+ 	"Can I be an argument of (e.g.) ifTrue:?"
+ 
+ 	^arguments size = 0!

Item was added:
+ ----- Method: BlockNode>>defaultBlockType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultBlockType: t1 
+ 	^ #default!

Item was added:
+ ----- Method: BlockNode>>defaultMessageType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultMessageType
+ 	^ #none!

Item was added:
+ ----- Method: BlockNode>>emitForEvaluatedEffect:on: (in category '*Etoys-Squeakland-code generation') -----
+ emitForEvaluatedEffect: stack on: aStream
+ 
+ 	self returns
+ 		ifTrue: 
+ 			[self emitForEvaluatedValue: stack on: aStream.
+ 			stack pop: 1]
+ 		ifFalse: 
+ 			[self emitExceptLast: stack on: aStream.
+ 			statements last emitForEffect: stack on: aStream]!

Item was added:
+ ----- Method: BlockNode>>firstInReceivers: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ firstInReceivers: t1 
+ 	^ t1 first!

Item was added:
+ ----- Method: BlockNode>>getAllChildren (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getAllChildren
+ 
+ 	^ arguments, statements, (temporaries ifNotNil: [temporaries] ifNil: [#()]).
+ !

Item was added:
+ ----- Method: BlockNode>>getElderSiblingOf: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getElderSiblingOf: node
+ 
+ 	| index |
+ 	temporaries ifNotNil: [
+ 		((index _ temporaries indexOf: node) > 1) ifTrue: [^ temporaries at: index - 1].
+ 		index = 1 ifTrue: [
+ 			arguments size > 0 ifTrue: [^ arguments last].
+ 		].
+ 	].
+ 	((index _ arguments indexOf: node) > 1) ifTrue: [^ arguments at: index - 1].
+ 	index = 1 ifTrue: [
+ 		statements size > 0 ifTrue: [^ statements last].
+ 	].
+ 	((index _ statements indexOf: node) > 1) ifTrue: [^ statements at: index - 1].
+ 	^ nil.
+ !

Item was added:
+ ----- Method: BlockNode>>getFirstChild (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getFirstChild
+ 
+ 	arguments size > 0 ifTrue: [^ arguments first].
+ 	statements size > 0 ifTrue: [^ statements first].
+ 	temporaries ifNotNil: [temporaries size > 0 ifTrue: [^ temporaries first]].
+ 	^ nil.
+ !

Item was added:
+ ----- Method: BlockNode>>getLastChild (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getLastChild
+ 
+ 	temporaries ifNotNil: [temporaries size > 0 ifTrue: [^ temporaries last]].
+ 	statements size > 0 ifTrue: [^ statements last].
+ 	arguments size > 0 ifTrue: [^ arguments last].
+ 	^ nil.
+ !

Item was added:
+ ----- Method: BlockNode>>initialNil (in category '*Etoys-Tweak-Kedama-Generated') -----
+ initialNil
+ 	^ nil!

Item was added:
+ ----- Method: BlockNode>>initialize (in category '*Etoys-Squeakland-accessing') -----
+ initialize
+ 
+ 	super initialize.
+ 	temporaries := #()!

Item was added:
+ ----- Method: BlockNode>>isFirstChild: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isFirstChild: childNode
+ 
+ 	arguments size > 0 ifTrue: [^ childNode = arguments first].
+ 	statements size > 0 ifTrue: [^ childNode = statements first].
+ 	temporaries ifNotNil: [temporaries size > 0 ifTrue: [^ childNode = temporaries first]].
+ 	^ false.
+ !

Item was added:
+ ----- Method: BlockNode>>isLastChild: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isLastChild: childNode
+ 
+ 	temporaries ifNotNil: [temporaries size > 0 ifTrue: [^ childNode = temporaries last]].
+ 	statements size > 0 ifTrue: [^ childNode = statements last].
+ 	arguments size > 0 ifTrue: [^ childNode = arguments last].
+ 	^ false.
+ !

Item was added:
+ ----- Method: BlockNode>>isStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isStmt: t1 
+ 	^ t1 = #top
+ 		or: [t1 = #condition]!

Item was added:
+ ----- Method: BlockNode>>isTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTest: t1 parentNode: t2 
+ 	t1 = true
+ 		ifTrue: [^ true].
+ 	^ (t2 isMemberOf: MessageNode)
+ 		and: [t2 receiver = self
+ 				and: [t2 messageType value = #condition]]!

Item was added:
+ ----- Method: BlockNode>>isTopStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmt: t1 
+ 	t1 = nil
+ 		ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: BlockNode>>isTopStmtForBlock: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmtForBlock: t1 
+ 	t1 = nil
+ 		ifTrue: [^ nil].
+ 	^ false!

Item was added:
+ ----- Method: BlockNode>>rcvr: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr: t1 
+ 	^ t1!

Item was added:
+ ----- Method: BlockNode>>replaceNode:with: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ replaceNode: childNode with: newNode
+ 
+ 	| index |
+ 	(index _ arguments indexOf: childNode) > 0
+ 		ifTrue: [arguments at: index put: newNode. ^ self].
+ 	(index _ statements indexOf: childNode) > 0
+ 		ifTrue: [statements at: index put: newNode. ^ self].
+ 	temporaries ifNotNil: [
+ 		(index _ temporaries indexOf: childNode) > 0
+ 			ifTrue: [temporaries at: index put: newNode. ^ self].
+ 	].
+ 
+ !

Item was added:
+ ----- Method: BlockNode>>returnSelfIfNoOther (in category '*Etoys-Squeakland-accessing') -----
+ returnSelfIfNoOther
+ 
+ 	self returns
+ 		ifFalse: 
+ 			[statements last == NodeSelf ifFalse: [statements add: NodeSelf].
+ 			self returnLast]!

Item was added:
+ ----- Method: BlockNode>>sizeForEvaluatedEffect: (in category '*Etoys-Squeakland-code generation') -----
+ sizeForEvaluatedEffect: encoder
+ 
+ 	self returns ifTrue: [^self sizeForEvaluatedValue: encoder].
+ 	^(self sizeExceptLast: encoder)
+ 		+ (statements last sizeForEffect: encoder)!

Item was added:
+ ----- Method: BlockNode>>sizeForEvaluatedValue: (in category '*Etoys-Squeakland-code generation') -----
+ sizeForEvaluatedValue: encoder
+ 
+ 	^(self sizeExceptLast: encoder)
+ 		+ (statements last sizeForValue: encoder)!

Item was added:
+ ----- Method: BlockNode>>sizeForValue: (in category '*Etoys-Squeakland-code generation') -----
+ sizeForValue: encoder
+ 	nArgsNode _ encoder encodeLiteral: arguments size.
+ 	remoteCopyNode _ encoder encodeSelector: #blockCopy:.
+ 	size _ (self sizeForEvaluatedValue: encoder)
+ 				+ (self returns ifTrue: [0] ifFalse: [1]). "endBlock"
+ 	arguments _ arguments collect:  "Chance to prepare debugger remote temps"
+ 				[:arg | arg asStorableNode: encoder].
+ 	arguments do: [:arg | size _ size + (arg sizeForStorePop: encoder)].
+ 	^1 + (nArgsNode sizeForValue: encoder) 
+ 		+ (remoteCopyNode size: encoder args: 1 super: false) + 2 + size!

Item was added:
+ ----- Method: BlockNode>>thisNode (in category '*Etoys-Tweak-Kedama-Generated') -----
+ thisNode
+ 	^ self!

Item was added:
+ ----- Method: BlockNode>>transfer: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 
+ 	^ t1!

Item was added:
+ ----- Method: BlockNode>>visitBy: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ visitBy: visitor
+ 
+ 	visitor visit: self.
+ 	arguments do: [:a | a visitBy: visitor].
+ 	statements do: [:a | a visitBy: visitor].
+ 	temporaries ifNotNil: [temporaries do: [:a | a visitBy: visitor]].
+ !

Item was added:
+ FormCanvas subclass: #BlueFormCanvas
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Support'!

Item was added:
+ ----- Method: BlueFormCanvas>>drawMorph: (in category 'drawing') -----
+ drawMorph: aMorph
+ 	"Draw a morph on the receiver"
+ 
+      (self isVisible: aMorph bounds) ifTrue: [self frameRectangle: aMorph bounds color: Color blue]
+ 
+ !

Item was changed:
  ----- Method: BookMorph class>>additionsToViewerCategories (in category '*eToys-scripting') -----
  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."
  
  	^ #((#'book navigation'
  			((command goto: 'go to the given page' Player)
  			(command nextPage 'go to next page')
  			(command previousPage 'go to previous page')
  			(command firstPage 'go to first page')
  			(command lastPage 'go to last page')
+ 			(slot pageNumber 'The ordinal number of the current page' Number readWrite Player getPageNumber Player setPageNumber:)
+ 			(slot numberOfPages 'How many pages here are in the book' Number readOnly Player getNumberOfPages Player unused)
+ 			(slot pageControlsShowing 'Whether page controls are showing in the book' Boolean readWrite Player getPageControlsShowing Player setPageControlsShowing:)
+ 			(slot pageControlsShort 'Whether page controls are shown in short form' Boolean readWrite Player getPageControlsShort Player setPageControlsShort:)
+ 			(slot pageControlsAtTop 'Whether page controls are shown at the top of the book' Boolean readWrite Player getPageControlsAtTop Player setPageControlsAtTop:)
+ 			(command revertPage 'revert to the original version of this page')
+ 			(command revertAllPages 'revert the entire book to its original contents')
+ 
+   )))!
- 			(slot pageNumber 'The ordinal number of the current page' Number readWrite Player getPageNumber Player setPageNumber:))))!

Item was added:
+ ----- Method: BookMorph class>>bookFromPagesInSISSFormat: (in category '*Etoys-Squeakland-fileIn/Out') -----
+ bookFromPagesInSISSFormat: sexp
+ 
+ 	| pages book pagesAndColor color |
+ 	pagesAndColor _ sexp sissReadObjects.
+ 	pages _ pagesAndColor copyFrom: 1 to: pagesAndColor size - 1.
+ 	color _ pagesAndColor last.
+ 	book _ BookMorph new.
+ 	pages do: [:p | p setProperty: #transitionSpec toValue: (Array with: 'silence' with: #none with: #none)].
+ 	book pageControlsAtTop: false.
+ 	book hidePageControls.
+ 	book newPages: pages.
+ 	book extent: pages first extent + (10 at 10).
+ 	book color: color.
+ 	book goToPage: 1.
+ 	^ book.
+ !

Item was added:
+ ----- Method: BookMorph>>addAdvancedItemsTo: (in category '*Etoys-Squeakland-menu') -----
+ addAdvancedItemsTo: aMenu
+ 	"Add advanced items to a menu which allow the user to affect all the pages of the book.  NB balloon help msgs still pending."
+ 
+ 
+ 	| subMenu |
+ 	subMenu := MenuMorph new defaultTarget: self.
+ 	subMenu addTranslatedList: #(
+ 		('make all pages the same size as this page' makeUniformPageSize 'Make all the pages of this book be the same size as the page currently showing.')
+ 	('set background color for all pages' #setPageColor 'Choose a color to assign as the background color for all of this book''s pages')
+ 		-
+ 		('uncache page sorter' 	uncachePageSorter)
+ 		('make a thread of projects in this book'  buildThreadOfProjects)
+ 		-
+ 		('make this the template for new pages' setNewPagePrototype)) translatedNoop.
+ 
+ 	"NB  The following 2 items do not get auto-updated in a persistent menu."
+ 	newPagePrototype ifNotNil: 
+ 		[subMenu add: 'clear new-page template' translated action: #clearNewPagePrototype].
+ 	self isInFullScreenMode
+ 		ifTrue:
+ 			[subMenu add: 'exit full screen' translated action: #exitFullScreen]
+ 		ifFalse:
+ 			[subMenu add: 'show full screen' translated action: #goFullScreen].
+ 
+ 	(ActiveHand pasteBuffer isKindOf: PasteUpMorph) ifTrue:
+ 		[subMenu addLine.
+ 		subMenu add: 'paste book page' translated   action: #pasteBookPage].
+ 
+ 	aMenu add: 'advanced...' translated subMenu: subMenu
+ 
+ !

Item was added:
+ ----- Method: BookMorph>>addAllPagesItemsTo: (in category '*Etoys-Squeakland-menu') -----
+ addAllPagesItemsTo: aMenu
+ 	"Add items to a menu which allow the user to affect all the pages of the book"
+ 
+ 
+ 	| subMenu |
+ 	true ifTrue: [^ self].  "Not using this form right now."
+ 	subMenu := MenuMorph new defaultTarget: self.
+ 
+ 	#(('make all pages this size' #makeUniformPageSize 'help')
+ 	('set background color for all pages' #setPageColor 'help')
+ 	('set sound effect for all pages' #menuPageSoundForAll: 'help')
+ 	('set visual effect for all pages' #menuPageVisualForAll:. 'help')) do:
+ 		[:tuple |	
+ 			subMenu add: tuple first target: self action: tuple second.
+ 			subMenu balloonTextForLastItem: tuple third].
+ 
+ 	aMenu add: 'change all pages...' subMenu: subMenu
+ 
+ !

Item was added:
+ ----- Method: BookMorph>>addBookToggleItemsTo: (in category '*Etoys-Squeakland-menu') -----
+ addBookToggleItemsTo: aMenu
+ 	"Add the standard book-related toggle items to a menu."
+ 
+ 
+ 	#(
+ 		(keepingUniformPageSizeString toggleMaintainUniformPageSize 'If set, when you resize the book, all of its pages get automatically resized.')
+ 		(pageControlsAtTopString togglePageControlsAtTop 'If on, page controls (when present), will appear at the the top of the book; if off, they will appear at its bottom')
+ 		(pageControlsShortString togglePageControlsShort 'If set, the shorter form of page controls will be used when page controls are showing')
+ 		(showingPageControlsString toggleShowingOfPageControls 'If set, a row of page controls will appear at the top of the book')
+ 		(usingPrivatePresenterString toggleUsingPrivatePresenter 'If set, stop-step-go buttons within the page''s interior will govern only scripts for objects residing within the page')
+ 		(showingFullScreenString toggleFullScreen 'If set, the book page occupies the entire screen')
+ 		(wrappingAtEndString toggleWrapPages 'If set, the first page in the book will be considered to be the next page after the last page, so that continuallly pressing the next or previous buttons will continually cycle through all pages of the book')
+ 	) translatedNoop do:
+ 			[:tuple |
+ 				aMenu addUpdating: tuple first target: self action: tuple second.
+ 				tuple size > 2 ifTrue:
+ 					[aMenu balloonTextForLastItem: tuple third translated]]!

Item was added:
+ ----- Method: BookMorph>>addSaveAndRevertItemsTo: (in category '*Etoys-Squeakland-menu') -----
+ addSaveAndRevertItemsTo: aMenu
+ 	"Add items relating to use of revertible page-prototypes "
+ 
+ 	| subMenu |
+ 	subMenu := MenuMorph new defaultTarget: self.
+ 	subMenu add: 'mark this page to be revertible' translated action: #markForRevert..
+ 	subMenu add: 'mark entire book to be revertible' translated action: #markBookForRevert.
+ 	aMenu add: 'save for later revert...' translated subMenu: subMenu!

Item was added:
+ ----- Method: BookMorph>>addTransitionItemsTo: (in category '*Etoys-Squeakland-menu') -----
+ addTransitionItemsTo: aMenu
+ 	"Add transition items to a menu which allow the user to affect all the pages of the book.
+ "
+ 
+ 	| subMenu |
+ 	subMenu := MenuMorph new defaultTarget: self.
+ 	subMenu addTranslatedList: #(
+ 		('set sound effect for this page' menuPageSoundForThisPage:)
+ 		('set visual effect for this page' menuPageVisualForThisPage:)
+ 		-
+ 		('set sound effect for all pages' menuPageSoundForAll: 'Establish a sound-effect that should be used whenever there is a transition between any two pages of this book.')
+ 		('set visual effect for all pages' menuPageVisualForAll:. 'Establish a visual -effect that should be used for all transitions between pages of this book')) translatedNoop.
+ 
+ 
+ 	aMenu add: 'visual and sound effects...' translated subMenu: subMenu
+ 
+ !

Item was added:
+ ----- Method: BookMorph>>bookMenu (in category '*Etoys-Squeakland-menu') -----
+ bookMenu
+ 	"Create and answer the standard book menu."
+ 
+ 	| aMenu |
+ 	aMenu _ MenuMorph new defaultTarget: self.
+ 	aMenu addTitle: 'Book' translated.
+ 	aMenu addStayUpItem.
+ 
+ 	aMenu addTranslatedList: #( 
+ 		('find...'   textSearch 'search the book for word(s)')
+ 		('find again'	textSearchAgain  'search for the next occurrence of a string')
+ 		-
+ 		('go to page...' goToPage 'go directly to a page, if you know its page-number')
+ 		('duplicate this page' duplicatePage 'add a new page just like this one to the book.')
+ 		-
+ 		('revert this page' revertPage  'restore this page to its initial condition, if possible.')
+ 		('revert entire book' revertAllPages 'restore all pages of this book to their initial condition if possible.')
+ 		-) translatedNoop.
+ 
+ 	self addBookToggleItemsTo: aMenu.
+ 
+ 	aMenu addTranslatedList: #(
+ 		-
+ 		('sort pages'  sortPages 'open a tool allowing you to arrange the pages of the book.')
+ 		('hand me a bookmark for this page'  bookmarkForThisPage 'make a bookmark object which, when clicked, will make the book turn to this page.')
+ 		('hand me a thumbnail for this page'  thumbnailForThisPage 'create an icon representing this page')
+ 		-) translatedNoop.
+ 
+ 	aMenu addLine.
+ 	self addTransitionItemsTo: aMenu.
+ 	self addSaveAndRevertItemsTo: aMenu.
+ 
+ 	self addAllPagesItemsTo: aMenu.  "At the moment this one does nothing"
+ 	self addAdvancedItemsTo: aMenu.
+ 
+ 	^ aMenu
+ 
+ "
+ Disused items:
+ 	 'send all pages to server' savePagesOnURL.
+ 	 'send this page to server' saveOneOnURL.
+ 	 'reload all from server' reload.
+ 	 'keep in one file' keepTogether.
+ 	 'load PPT images from slide #1' loadImagesIntoBook.
+ 	 'copy page url to clipboard' copyUrl."
+ 
+ !

Item was added:
+ ----- Method: BookMorph>>canRevertThisPage (in category '*Etoys-Squeakland-e-toy support') -----
+ canRevertThisPage
+ 	"A normal page cannot be reverted to an earlier configuation.  If a page has the property revertKey, it will be in index into the book's pagesForRevert, where a backup page is.  The user can ask to revert after messing up a page.  Good for tutorials.  Only authors are expected to turn preserve pages using saveForRevert."
+ 
+ 	^ currentPage hasProperty: #revertKey!

Item was added:
+ ----- Method: BookMorph>>currentPage: (in category '*Etoys-Squeakland-accessing') -----
+ currentPage: aPage
+ 
+ 	currentPage _ aPage.
+ 	(currentPage notNil and: [
+ 		(aPage hasProperty: #revertMarked) and: [
+ 			(self revertablePageForPage: aPage) isNil]]) ifTrue: [
+ 		self markForRevert: aPage
+ 	].
+ 	^ aPage.
+ !

Item was added:
+ ----- Method: BookMorph>>deleteAlongWithPlayers (in category '*Etoys-Squeakland-e-toy support') -----
+ deleteAlongWithPlayers
+ 
+ 	| set |
+ 	set _ Set new.
+ 	pages do: [:page |
+ 		page allMorphsDo: [:e |
+ 			e player notNil ifTrue: [set add: e player]. e delete]].
+ 	self allMorphsDo: [:e | e player notNil ifTrue: [set add: e player]. e delete].
+ 	set do: [:p | p class scripts do: [:s | p class removeScriptNamed: s selector]].
+ 	(set select: [:p | p class isSystemDefined not]) do: [:p | p class removeFromSystemUnlogged].
+ !

Item was added:
+ ----- Method: BookMorph>>deletePageAlongWithPlayers: (in category '*Etoys-Squeakland-new reverting') -----
+ deletePageAlongWithPlayers: page
+ 
+ 	| set |
+ 	set _ Set new.
+ 	page allMorphsDo: [:e |
+ 		e player notNil ifTrue: [set add: e player]. e delete].
+ 	(set select: [:p | p class isSystemDefined not]) do: [:p | p class removeFromSystemUnlogged].
+ !

Item was added:
+ ----- Method: BookMorph>>duplicatePage (in category '*Etoys-Squeakland-menu') -----
+ duplicatePage
+ 	"Insert a new page after the current one, and make it the current page."
+ 
+ 	| newPage currIndex |
+ 	newPage := self currentPage veryDeepCopy.
+ 	self insertPage: newPage pageSize: newPage extent atIndex: (currIndex := pages indexOf: currentPage).
+ 	self goToPage: currIndex + 1!

Item was added:
+ ----- Method: BookMorph>>invokeShortBookMenu (in category '*Etoys-Squeakland-menu') -----
+ invokeShortBookMenu
+ 	"Invoke the shorter version of the book's control panel menu."
+ 
+ 	| aMenu |
+ 	self class == BookMorph ifFalse: [^ self invokeBookMenu].  
+ 
+ 	aMenu _ MenuMorph new defaultTarget: self.
+ 	aMenu addTitle: 'Book' translated.
+ 	aMenu addStayUpItem.
+ 
+ 	aMenu addTranslatedList: #( 
+ 		('find...'   textSearch)
+ 		('go to page...' goToPage)
+ 		-
+ 		('show more controls' showMoreControls)
+ 		-
+ 		('revert this page' revertPage)
+ 		('revert entire book' revertAllPages)) translatedNoop.
+ 
+ 	aMenu popUpInWorld 
+ !

Item was added:
+ ----- Method: BookMorph>>markBookForRevert (in category '*Etoys-Squeakland-new reverting') -----
+ markBookForRevert
+ 
+ 	pages do: [:pg | self markForRevert: pg].
+ !

Item was added:
+ ----- Method: BookMorph>>markForRevert (in category '*Etoys-Squeakland-new reverting') -----
+ markForRevert
+ 
+ 	self markForRevert: currentPage.
+ !

Item was added:
+ ----- Method: BookMorph>>markForRevert: (in category '*Etoys-Squeakland-new reverting') -----
+ markForRevert: page
+ 	"Save the current page for future revert."
+ 
+ 	| key revertPage revertDict |
+ 	page setProperty: #revertMarked toValue: true.
+ 
+ 	revertDict _ self pagesForRevert.
+ 
+ 	key _ page valueOfProperty: #revertKey ifAbsent: [0].
+ 	revertPage := revertDict at: key ifAbsent: [nil].
+ 	(key = 0 or: [revertPage isNil])
+ 		ifTrue:
+ 			[key := pages inject: 0 into:
+ 				[:max :p | max max: (p  valueOfProperty: #revertKey ifAbsent: [0]) + 1].
+ 			page setProperty: #revertKey toValue: key.
+ 			revertDict at: key put: page copy]
+ 		ifFalse:
+ 			[
+ 			self deletePageAlongWithPlayers: revertPage.
+ 			revertDict at: key put: page copy]!

Item was added:
+ ----- Method: BookMorph>>pageControlsAtTop (in category '*Etoys-Squeakland-uniform page size') -----
+ pageControlsAtTop
+ 	"Answer whether I am currently set up to have my page-controls appear at top"
+ 
+ 	^ self valueOfProperty: #pageControlsAtTop ifAbsentPut: [true]!

Item was added:
+ ----- Method: BookMorph>>pageControlsAtTop: (in category '*Etoys-Squeakland-uniform page size') -----
+ pageControlsAtTop: aBoolean
+ 	"Set the property governing whether page controls will appear at top"
+ 
+ 	self setProperty: #pageControlsAtTop toValue: aBoolean.
+ 	self pageControlsVisible ifTrue:
+ 		[self hidePageControls.
+ 		self showPageControls]!

Item was added:
+ ----- Method: BookMorph>>pageControlsShort (in category '*Etoys-Squeakland-uniform page size') -----
+ pageControlsShort
+ 	"Answer whether I am currently set up to have my page-controls be in the short form"
+ 
+ 	^ self valueOfProperty: #pageControlsShort ifAbsentPut:
+ 		[true]!

Item was added:
+ ----- Method: BookMorph>>pageControlsShort: (in category '*Etoys-Squeakland-uniform page size') -----
+ pageControlsShort: aBoolean
+ 	"Set the property governing whether page controls will appear in their short form"
+ 
+ 	self setProperty: #pageControlsShort toValue: aBoolean.
+ 	self pageControlsVisible
+ 		ifTrue:
+ 			[self hidePageControls.
+ 			self showPageControls]
+ 		ifFalse:
+ 			[self hidePageControls]!

Item was added:
+ ----- Method: BookMorph>>pageNumberReport (in category '*Etoys-Squeakland-page controls') -----
+ pageNumberReport
+ 	"Answer a string representing the page number."
+ 
+ 	^ (pages indexOf: currentPage ifAbsent: [0]) printString, '/', pages size printString!

Item was added:
+ ----- Method: BookMorph>>pagesAndColorInSISSFormat (in category '*Etoys-Squeakland-fileIn/out') -----
+ pagesAndColorInSISSFormat
+ 
+ 	| dict |
+ 	dict _ SISSDictionaryForGuideBook new initialize.
+ 	self owner ifNotNil: [
+ 		dict boundaryObjects add: self.
+ 	].
+ 	^ dict sissScanObjectsFrom: self.!

Item was added:
+ ----- Method: BookMorph>>pagesForRevert (in category '*Etoys-Squeakland-new reverting') -----
+ pagesForRevert
+ 	"A normal book has its pages in the pages inst var, and cannot revert a page.  If a book has the property pagesForRevert, then any (or all) pages can have a backup copy.  The user can ask to revert after messing up a page.  Good for tutorials.  Only authors are expected to preserve pages using saveForRevert.
+ 	This method creates and returns the pagesForRevert collection.  It is a journal and is not in the same order as pages."
+ 
+ 	| revColl |
+ 	revColl _ self valueOfProperty: #pagesForRevert ifAbsent: [nil].
+ 	(revColl notNil and: [(revColl isKindOf: Dictionary) not]) ifTrue: [
+ 		revColl do: [:p |
+ 			self deletePageAlongWithPlayers: p value
+ 		].
+ 		revColl _ nil.
+ 	].
+ 	revColl ifNil: [
+ 		revColl _ Dictionary new.
+ 		self setProperty: #pagesForRevert toValue: revColl.
+ 	].
+ 	^ revColl.!

Item was added:
+ ----- Method: BookMorph>>revertAllPages (in category '*Etoys-Squeakland-new reverting') -----
+ revertAllPages
+ 	"Go back to saved copies of all pages."
+ 
+ 	pages do: [:e | self revertPageInner: e].
+ 	self goToPage: 1!

Item was added:
+ ----- Method: BookMorph>>revertPage (in category '*Etoys-Squeakland-new reverting') -----
+ revertPage
+ 
+ 	(self revertPageInner: currentPage) ifFalse: [
+ 		^ self inform: 'sorry, nothing was saved for this page.' translated].
+ !

Item was added:
+ ----- Method: BookMorph>>revertPageInner: (in category '*Etoys-Squeakland-new reverting') -----
+ revertPageInner: aPage
+ 
+ 	| replacement index newReplacement |
+ 	replacement _ self revertablePageForPage: aPage.
+ 	replacement ifNil: [^ false].
+ 
+ 	index := pages indexOf: aPage.
+ 	newReplacement _ replacement veryDeepCopy.
+ 	newReplacement setNameTo: 'page'.
+ 	pages at: index put: newReplacement.
+ 
+ 	(pages at: index) position: aPage position.
+ 	aPage == currentPage ifTrue: [aPage owner ifNotNil: [aPage owner addMorph: newReplacement inFrontOf: aPage]].
+ 
+ 	self deletePageAlongWithPlayers: aPage.
+ 	aPage removeViewersOnSubsIn: self presenter.
+ 	aPage == currentPage ifTrue: [self currentPage: newReplacement].
+ 
+ 	^ true.
+ 
+ !

Item was added:
+ ----- Method: BookMorph>>revertablePageForKey: (in category '*Etoys-Squeakland-new reverting') -----
+ revertablePageForKey: anInteger
+ 	"If I have a saved page with the given revertKey, an Integer, answer it, else answer nil."
+ 
+ 	| forRevert |
+ 	(forRevert := self pagesForRevert) isEmptyOrNil
+ 		ifTrue: [^ nil].
+ 	^ forRevert at: anInteger ifAbsent: [nil].
+ !

Item was added:
+ ----- Method: BookMorph>>revertablePageForPage: (in category '*Etoys-Squeakland-new reverting') -----
+ revertablePageForPage: aPage
+ 	"If I have a saved page for the page, answer it, else answer nil."
+ 
+ 	| forRevert key |
+ 	(forRevert := self pagesForRevert) isEmptyOrNil
+ 		ifTrue: [^ nil].
+ 	key := aPage valueOfProperty: #revertKey ifAbsent: [0].
+ 	^ forRevert at: key ifAbsent: [nil].
+ !

Item was added:
+ ----- Method: BookMorph>>saveBookForRevert (in category '*Etoys-Squeakland-master pages') -----
+ saveBookForRevert
+ 	"Consider this the master version of the book, with regard to which pages are in it, what their order is, and what their content is"
+ 
+ 	| forRevert |
+ 	forRevert := OrderedCollection new.
+ 	pages doWithIndex: 
+ 		[: pg :index | 
+ 			pg setProperty: #revertKey toValue: index.
+ 			forRevert add: (index -> pg copy)].
+ 	self setProperty:# pagesForRevert toValue: forRevert!

Item was added:
+ ----- Method: BookMorph>>saveForRevert (in category '*Etoys-Squeakland-menu commands') -----
+ saveForRevert
+ 	"Save the current page for future revert."
+ 
+ 	| revertAssocs key assoc |
+ 	revertAssocs _ self pagesForRevert.
+ 	key _ currentPage valueOfProperty: #revertKey ifAbsent: [0].
+ 	assoc := revertAssocs detect: [:a | a key = key] ifNone: [nil].
+ 	(key = 0 or: [assoc isNil])
+ 		ifTrue:
+ 			[key :=  revertAssocs ifEmpty: [1] ifNotEmpty: [(revertAssocs collect: [:a | a key]) max + 1].
+ 			currentPage setProperty: #revertKey toValue: key.
+ 			revertAssocs add: (key -> currentPage copy)]
+ 		ifFalse:
+ 			[assoc value: currentPage copy]!

Item was added:
+ ----- Method: BookMorph>>storeAsDataStream (in category '*Etoys-Squeakland-fileIn/out') -----
+ storeAsDataStream
+ 
+ 	self storeAsDataStreamNamed: Project current name, '.sexp.data.gz'.!

Item was added:
+ ----- Method: BookMorph>>storeAsDataStreamNamed: (in category '*Etoys-Squeakland-fileIn/out') -----
+ storeAsDataStreamNamed: zippedFileName
+ 
+ 	| f d bytes zipped |
+ 	bytes _ WriteStream on: ByteArray new.
+ 	d _ DataStream on: bytes.
+ 	d nextPut: self pagesAndColorInSISSFormat.
+ 	d close.
+ 	f _ FileStream newFileNamed: zippedFileName.
+ 	f binary; setFileTypeToObject.
+ 	zipped _ GZipWriteStream on: f.
+ 	zipped nextPutAll: bytes contents.
+ 	zipped close.
+ 	f close
+ !

Item was added:
+ ----- Method: BookMorph>>textSearchAgain (in category '*Etoys-Squeakland-menu') -----
+ textSearchAgain
+ 	"The classic find-again"
+ 
+ 	| wanted wants list |
+ 	list _ self valueOfProperty: #searchKey ifAbsent: [#()].
+ 	wanted _ String streamContents: [:strm | 
+ 			list do: [:each | strm nextPutAll: each; space]].
+ 	wants _ wanted findTokens: Character separators.
+ 	wants isEmpty ifTrue: [^ self].
+ 	self getAllText.		"save in allText, allTextUrls"
+ 	^ self findText: wants	"goes to the page and highlights the text"!

Item was added:
+ ----- Method: BookMorph>>togglePageControlsAtTop (in category '*Etoys-Squeakland-uniform page size') -----
+ togglePageControlsAtTop
+ 	"Toggle whether or not the receiver's page controls should appear at top"
+ 
+ 	self pageControlsAtTop: self pageControlsAtTop not!

Item was added:
+ ----- Method: BookMorph>>togglePageControlsShort (in category '*Etoys-Squeakland-uniform page size') -----
+ togglePageControlsShort
+ 	"Toggle whether or not the receiver's page controls should be in the short form"
+ 
+ 	self pageControlsShort: self pageControlsShort not!

Item was added:
+ ----- Method: BookMorph>>toggleUsingPrivatePresenter (in category '*Etoys-Squeakland-uniform page size') -----
+ toggleUsingPrivatePresenter
+ 	"Toggle whether or not the receiver's current page should use  a private presenter."
+ 
+ 	self usesPrivatePresenter
+ 		ifFalse:
+ 			[currentPage impartPrivatePresenter]
+ 		ifTrue:
+ 			[currentPage abandonPrivatePresenter]!

Item was added:
+ ----- Method: BookMorph>>toggleWrapPages (in category '*Etoys-Squeakland-navigation') -----
+ toggleWrapPages
+ 	"Toggle whether in wrapping-pages mode"
+ 
+ 	self setWrapPages: (self hasProperty: #dontWrapAtEnd)!

Item was added:
+ ----- Method: BookMorph>>unmarkBookForRevert (in category '*Etoys-Squeakland-new reverting') -----
+ unmarkBookForRevert
+ 
+ 	pages do: [:p | self unmarkForRevert: p].
+ !

Item was added:
+ ----- Method: BookMorph>>unmarkForRevert (in category '*Etoys-Squeakland-new reverting') -----
+ unmarkForRevert
+ 
+ 	^ self unmarkForRevert: currentPage.
+ !

Item was added:
+ ----- Method: BookMorph>>unmarkForRevert: (in category '*Etoys-Squeakland-new reverting') -----
+ unmarkForRevert: page
+ 	"Forget the data around reverting for this page."
+ 
+ 	| key revertPage |
+ 	revertPage _ self revertablePageForPage: page.
+ 	revertPage ifNotNil: [
+ 		key _ page valueOfProperty: #revertKey.
+ 		page removeProperty: #revertKey.
+ 		page removeProperty: #revertMarked.
+ 		self deletePageAlongWithPlayers: revertPage.
+ 		self pagesForRevert removeKey: key].
+ !

Item was added:
+ ----- Method: BookMorph>>usesPrivatePresenter (in category '*Etoys-Squeakland-uniform page size') -----
+ usesPrivatePresenter
+ 	"Answer whether the current page uses a private presenter"
+ 
+ 	^ currentPage hasPrivatePresenter!

Item was added:
+ ----- Method: BookMorph>>usingPrivatePresenterString (in category '*Etoys-Squeakland-uniform page size') -----
+ usingPrivatePresenterString
+ 	"Answer a string characterizing whether I am currently maintaining uniform page size"
+ 
+ 	^ (self usesPrivatePresenter
+ 		ifTrue: ['<yes>']
+ 		ifFalse: ['<no>']), 'scripting area' translated!

Item was added:
+ ----- Method: BookMorph>>wrappingAtEndString (in category '*Etoys-Squeakland-uniform page size') -----
+ wrappingAtEndString
+ 	"Answer a string characterizing whether I am currently set up to wrap around from last page to first"
+ 
+ 	^ ((self hasProperty: #dontWrapAtEnd)
+ 		ifFalse: ['<yes>']
+ 		ifTrue: ['<no>']), 'wrap after last page' translated!

Item was added:
+ ----- Method: BookPageSorterMorph>>revealBook (in category '*Etoys-Squeakland-menu') -----
+ revealBook
+ 	"Reveal the book to which I pertain."
+ 
+ 	book assuredPlayer beRevealedInActiveWorld.
+ 	book owner isPlayfieldLike ifTrue: [book comeToFront]!

Item was added:
+ ----- Method: BooklikeMorph>>evenFewerPageControls (in category '*Etoys-Squeakland-page controls') -----
+ evenFewerPageControls
+ 
+ 	^ self evenFewerPageControlsAllowDragging: true.
+ !

Item was added:
+ ----- Method: BooklikeMorph>>evenFewerPageControlsAllowDragging: (in category '*Etoys-Squeakland-page controls') -----
+ evenFewerPageControlsAllowDragging: aBoolean
+ 	self currentEvent shiftPressed
+ 		ifTrue:
+ 			[self hidePageControls]
+ 		ifFalse:
+ 			[self showPageControls: self minimumControlSpecs allowDragging: aBoolean]!

Item was added:
+ ----- Method: BooklikeMorph>>makeDescriptionViewer (in category '*Etoys-Squeakland-page controls') -----
+ makeDescriptionViewer
+ 
+ 	| descriptionItem font box |
+ 	font _ Preferences standardMenuFont.
+ 	descriptionItem := UpdatingStringMorph new.
+ 	descriptionItem target: self; getSelector: #descriptionReport.
+ 	descriptionItem useStringFormat.
+ 	descriptionItem font: font.
+ 
+ 	box _ Morph new.
+ 	box color: Color transparent.
+ 	box layoutPolicy: TableLayout new.
+ 	box vResizing: #rigid.
+ 	box hResizing: #rigid.
+ 	box color: (Color r: 0.839 g: 1.0 b: 0.806).
+ 	box borderWidth: 1.
+ 	box  borderColor: (Color r: 0.645 g: 0.774 b: 0.613).
+ 
+ 	box cellInset: 3.
+ 	box cellPositioning: #center.
+ 	box listCentering: #center.
+ 	box wrapCentering: #center.
+ 
+ 	box width: (font widthOfString: (String new: 14 withAll: $M)).
+ 	box height: font height + 4.
+ 	box addMorph: descriptionItem.
+ 	"box on: #mouseUp send: #showDescriptionMenu: to: self."
+ 	^ box!

Item was added:
+ ----- Method: BooklikeMorph>>makePageNumberItem (in category '*Etoys-Squeakland-page controls') -----
+ makePageNumberItem
+ 
+ 	| pageNumberItem |
+ 	pageNumberItem := UpdatingStringMorph new.
+ 	pageNumberItem target: self; getSelector: #pageNumberReport.
+ 	pageNumberItem useStringFormat.
+ 	pageNumberItem font: Preferences standardMenuFont.
+ 	^ pageNumberItem!

Item was added:
+ ----- Method: BooklikeMorph>>minimumControlSpecs (in category '*Etoys-Squeakland-page controls') -----
+ minimumControlSpecs
+ 	"Answer  specs defining the widgets in the short form of the control panel."
+ 
+ ^ {
+ 		#spacer.
+ 		#variableSpacer.
+ 		{#PrevPage. 			#previousPage.			'Previous page' translated}.
+ 		#spacer.
+ 		{#NextPage.		#nextPage.				'Next page' translated}.
+ 		#variableSpacer.
+ 		#spacer.
+ }
+ !

Item was added:
+ ----- Method: BooklikeMorph>>moveViaTitle (in category '*Etoys-Squeakland-misc') -----
+ moveViaTitle
+ 
+ 	(self isSticky not) ifTrue: [self activeHand grabMorph: self]
+ !

Item was added:
+ ----- Method: BooklikeMorph>>moveViaTitle:event:from: (in category '*Etoys-Squeakland-misc') -----
+ moveViaTitle: arg event: evt from: aMorph
+ 
+ 	(arg isSticky not) ifTrue: [self activeHand grabMorph: self]
+ !

Item was added:
+ ----- Method: BooklikeMorph>>pageControls (in category '*Etoys-Squeakland-page controls') -----
+ pageControls
+ 	"Return the page controls colums"
+ 
+ 	^ self submorphWithProperty: #pageControl!

Item was added:
+ ----- Method: BooklikeMorph>>pageControlsAtTopString (in category '*Etoys-Squeakland-misc') -----
+ pageControlsAtTopString
+ 	"Answer a string characterizing whether page controls are currently shown at the top of the book."
+ 
+ 	^ (self pageControlsAtTop ifTrue: ['<yes>'] ifFalse: ['<no>']),
+ 		'page controls at top' translated!

Item was added:
+ ----- Method: BooklikeMorph>>pageControlsShortString (in category '*Etoys-Squeakland-misc') -----
+ pageControlsShortString
+ 	"Answer a string characterizing whether page controls are currently to be shown in their short form."
+ 
+ 	^ (self pageControlsShort ifTrue: ['<yes>'] ifFalse: ['<no>']),
+ 		'page controls short' translated!

Item was added:
+ ----- Method: BooklikeMorph>>showPageControls:allowDragging: (in category '*Etoys-Squeakland-page controls') -----
+ showPageControls: controlSpecs allowDragging: aBoolean
+ 	"Remove any existing page controls, and add fresh controls at the top of the receiver (or in position 2 if the receiver's first submorph is one with property #header).  Add a single column of controls."
+ 
+ 	| pageControls column |
+ 	self hidePageControls.
+ 	column _ AlignmentMorph newColumn beTransparent.
+ 	pageControls _ self makePageControlsFrom: controlSpecs.
+ 	pageControls borderWidth: 0; layoutInset: 4.
+ 	pageControls beSticky.
+ 	pageControls setNameTo: 'Page Controls'.
+ 	aBoolean ifTrue: [pageControls on: #mouseDown send: #moveViaTitle:event:from: to: self withValue: column].
+ 	column addMorphBack: pageControls.
+ 	self addPageControlMorph: column!

Item was added:
+ ----- Method: Boolean>>xor: (in category '*Etoys-Squeakland-logical operations') -----
+ xor: aBoolean 
+ 	"Exclusive OR. Answer true if the receiver is not equivalent to aBoolean."
+ 
+ 	^(self == aBoolean) not!

Item was added:
+ PreferenceView subclass: #BooleanPreferenceView
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Support'!
+ 
+ !BooleanPreferenceView commentStamp: '<historical>' prior: 0!
+ I am responsible for building the visual representation of a preference that accepts true and false values!

Item was added:
+ ----- Method: BooleanPreferenceView class>>handlesPanel: (in category 'view registry') -----
+ handlesPanel: aPreferencePanel
+ 	^aPreferencePanel isKindOf: PreferencesPanel!

Item was added:
+ ----- Method: BooleanPreferenceView class>>initialize (in category 'class initialization') -----
+ initialize
+ 	PreferenceViewRegistry ofBooleanPreferences register: self.!

Item was added:
+ ----- Method: BooleanPreferenceView class>>unload (in category 'class initialization') -----
+ unload
+ 	PreferenceViewRegistry ofBooleanPreferences unregister: self.!

Item was added:
+ ----- Method: BooleanPreferenceView>>offerPersistenceMenu (in category 'user interface') -----
+ offerPersistenceMenu
+ 	| aMenu |
+ 	Preferences ensurePersistedPreferencesAccessible
+ 		ifFalse: [^self].
+ 	aMenu := MenuMorph new defaultTarget: self preference.
+ 	aMenu addTitle: self preference name.
+ 	aMenu addUpdating: #isEnabledOnStartupString target: self preference  selector: #persistValue: argumentList: {true}.
+ 	aMenu addUpdating: #isDisabledOnStartupString target: self preference  selector: #persistValue: argumentList: {false}.
+ 	aMenu addUpdating: #isNotSetOnStartupString target: self preference  selector: #persistValue: argumentList: {nil}.
+ 	aMenu popUpInWorld!

Item was added:
+ ----- Method: BooleanPreferenceView>>offerPreferenceNameMenu:with:in: (in category 'user interface') -----
+ offerPreferenceNameMenu: aPanel with: ignored1 in: ignored2
+ 	"the user clicked on a preference name -- put up a menu"
+ 
+ 	| aMenu |
+ 	ActiveHand showTemporaryCursor: nil.
+ 	aMenu := MenuMorph new defaultTarget: self preference.
+ 	aMenu addTitle: self preference name.
+ 
+ 	(Preferences okayToChangeProjectLocalnessOf: self preference name) ifTrue:
+ 		[aMenu addUpdating: #isProjectLocalString target: self preference action: #toggleProjectLocalness.
+ 		aMenu balloonTextForLastItem: 'Some preferences are best applied uniformly to all projects, and others are best set by each individual project.  If this item is checked, then this preference will be printed in bold and will have a separate value for each project' translated].
+ 
+ 	aMenu add: 'browse senders' translated target: self systemNavigation selector: #browseAllCallsOn: argument: self preference name.
+ 	aMenu balloonTextForLastItem: 'This will open a method-list browser on all methods that the send the preference "' translated, self preference name, '".'. 
+ 	aMenu add: 'show category...' translated target: aPanel selector: #findCategoryFromPreference: argument: self preference name.
+ 	aMenu balloonTextForLastItem: 'Allows you to find out which category, or categories, this preference belongs to.' translated.
+ 
+ 	Smalltalk isMorphic ifTrue:
+ 		[aMenu add: 'hand me a button for this preference' translated target: self selector: #tearOffButton.
+ 		aMenu balloonTextForLastItem: 'Will give you a button that governs this preference, which you may deposit wherever you wish' translated].
+ 
+ 	aMenu add: 'copy this name to clipboard' translated target: self preference selector: #copyName.
+ 	aMenu balloonTextForLastItem: 'Copy the name of the preference to the text clipboard, so that you can paste into code somewhere' translated.
+ 	aMenu add: 'set automatically on startup...' translated target: self selector: #offerPersistenceMenu.
+ 	aMenu balloonTextForLastItem: 'Store a value for this preference on file. On startup, it will be automatically restored.' translated.
+ 
+ 	aMenu popUpInWorld!

Item was added:
+ ----- Method: BooleanPreferenceView>>representativeButtonWithColor:inPanel: (in category 'user interface') -----
+ representativeButtonWithColor: aColor inPanel: aPreferencesPanel
+ 	"Return a button that controls the setting of prefSymbol.  It will keep up to date even if the preference value is changed in a different place"
+ 
+ 	| outerButton aButton str miniWrapper |
+ 	
+ 	outerButton := AlignmentMorph newRow height: 24.
+ 	outerButton color:  (aColor ifNil: [Color r: 0.645 g: 1.0 b: 1.0]).
+ 	outerButton hResizing: (aPreferencesPanel ifNil: [#shrinkWrap] ifNotNil: [#spaceFill]).
+ 	outerButton vResizing: #shrinkWrap.
+ 	outerButton addMorph: (aButton := UpdatingThreePhaseButtonMorph checkBox).
+ 	aButton
+ 		target: self preference;
+ 		actionSelector: #togglePreferenceValue;
+ 		getSelector: #preferenceValue.
+ 
+ 	outerButton addTransparentSpacerOfSize: (2 @ 0).
+ 	str := StringMorph contents: self preference name font: Preferences standardButtonFont.
+ 
+ 	self preference localToProject ifTrue:
+ 		[str emphasis: 1].
+ 
+ 	miniWrapper := AlignmentMorph newRow hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ 	miniWrapper layoutInset: 0.
+ 	miniWrapper beTransparent addMorphBack: str lock.
+ 	aPreferencesPanel
+ 		ifNotNil:  "We're in a Preferences panel"
+ 			[miniWrapper on: #mouseDown send: #offerPreferenceNameMenu:with:in: to: self withValue: aPreferencesPanel.
+ 			miniWrapper on: #mouseEnter send: #menuButtonMouseEnter: to: miniWrapper.
+ 			miniWrapper on: #mouseLeave send: #menuButtonMouseLeave: to: miniWrapper.
+ 			miniWrapper setBalloonText: 'Click here for a menu of options regarding this preference.  Click on the checkbox to the left to toggle the setting of this preference' translated]
+ 
+ 		ifNil:  "We're a naked button, not in a panel"
+ 			[miniWrapper setBalloonText: self preference helpString translated; setProperty: #balloonTarget toValue: aButton].
+ 
+ 	outerButton addMorphBack: miniWrapper.
+ 	outerButton setNameTo: self preference name.
+ 
+ 	aButton setBalloonText: self preference helpString.
+ 
+ 	^ outerButton
+ !

Item was added:
+ ----- Method: BooleanScriptEditor>>parseNodeWith: (in category '*Etoys-Squeakland-other') -----
+ parseNodeWith: encoder
+ 
+ 	(submorphs notEmpty and: [submorphs first submorphs notEmpty]) 
+ 		ifTrue: [^ super parseNodeWith: encoder].
+ 	^ encoder encodeLiteral: true.
+ !

Item was added:
+ ----- Method: BooleanScriptEditor>>sexpWith: (in category '*Etoys-Squeakland-other') -----
+ sexpWith: dictionary
+ 
+ 	(submorphs notEmpty and: [submorphs first submorphs notEmpty]) 
+ 		ifTrue: [^ super sexpWith: dictionary].
+ 	^ SExpElement keyword: #literal
+ 		attributes: (SExpAttributes with: #value->'true' with: #type->'Boolean').
+ !

Item was changed:
  ----- Method: BooleanScriptEditor>>storeCodeOn:indent: (in category 'other') -----
  storeCodeOn: aStream indent: tabCount 
  	(submorphs notEmpty and: [submorphs first submorphs notEmpty]) 
  		ifTrue: 
+ 			[aStream nextPutAll: '('.
- 			[aStream nextPutAll: '(('.
  			super storeCodeOn: aStream indent: tabCount.
+ 			aStream nextPutAll: ')'.
- 			aStream nextPutAll: ') ~~ false)'.
  			^self].
  	aStream nextPutAll: ' true '!

Item was added:
+ ----- Method: BorderedMorph>>useRoundedCornersInEtoys (in category '*Etoys-Squeakland-accessing') -----
+ useRoundedCornersInEtoys
+ 	Preferences roundedWindowCorners
+ 		ifTrue: [self useRoundedCorners]!

Item was added:
+ StringMorph subclass: #BorderedStringMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Widgets'!

Item was added:
+ ----- Method: BorderedStringMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 	| nameForm |
+ 	font _ self fontToUse.
+ 	nameForm _ Form extent: bounds extent depth: 8.
+ 	nameForm getCanvas drawString: contents at: 0 at 0 font: self fontToUse color: Color black.
+ 	(bounds origin + 1) eightNeighbors do: [ :pt |
+ 		aCanvas
+ 			stencil: nameForm 
+ 			at: pt
+ 			color: self borderColor.
+ 	].
+ 	aCanvas
+ 		stencil: nameForm 
+ 		at: bounds origin + 1 
+ 		color: color.
+ 
+ 
+ 	
+ !

Item was added:
+ ----- Method: BorderedStringMorph>>initWithContents:font:emphasis: (in category 'initialization') -----
+ initWithContents: aString font: aFont emphasis: emphasisCode
+ 	super initWithContents: aString font: aFont emphasis: emphasisCode.
+ 	self borderStyle: (SimpleBorder width: 1 color: Color white).!

Item was added:
+ ----- Method: BorderedStringMorph>>initialize (in category 'initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ 	super initialize.
+ ""
+ 	self
+ 		borderStyle: (SimpleBorder width: 1 color: Color white)!

Item was added:
+ ----- Method: BorderedStringMorph>>measureContents (in category 'accessing') -----
+ measureContents
+ 	^super measureContents +2.!

Item was added:
+ ----- Method: BraceNode>>defaultBlockType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultBlockType: t1 
+ 	^ #default!

Item was added:
+ ----- Method: BraceNode>>defaultMessageType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultMessageType
+ 	^ #none!

Item was added:
+ ----- Method: BraceNode>>firstInReceivers: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ firstInReceivers: t1 
+ 	^ t1 first!

Item was added:
+ ----- Method: BraceNode>>getAllChildren (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getAllChildren
+ 
+ 	^ elements.
+ !

Item was added:
+ ----- Method: BraceNode>>getElderSiblingOf: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getElderSiblingOf: node
+ 
+ 	| index |
+ 	((index _ elements indexOf: node) > 1) ifTrue: [^ elements at: index - 1].
+ 	^ nil.
+ !

Item was added:
+ ----- Method: BraceNode>>getFirstChild (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getFirstChild
+ 
+ 	elements size > 0 ifTrue: [^ elements first].
+ 	^ nil.
+ !

Item was added:
+ ----- Method: BraceNode>>getLastChild (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getLastChild
+ 
+ 	elements size > 0 ifTrue: [^ elements last].
+ 	^ nil.
+ !

Item was added:
+ ----- Method: BraceNode>>isFirstChild: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isFirstChild: childNode
+ 
+ 	elements size = 0 ifTrue: [^ false].
+ 	^ childNode = elements first.
+ !

Item was added:
+ ----- Method: BraceNode>>isLastChild: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isLastChild: childNode
+ 
+ 	elements size = 0 ifTrue: [^ false].
+ 	^ childNode = elements last.
+ !

Item was added:
+ ----- Method: BraceNode>>isStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isStmt: t1 
+ 	^ t1 = #top
+ 		or: [t1 = #condition]!

Item was added:
+ ----- Method: BraceNode>>isTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTest: t1 parentNode: t2 
+ 	t1 = true
+ 		ifTrue: [^ true].
+ 	^ (t2 isMemberOf: MessageNode)
+ 		and: [t2 receiver = self
+ 				and: [t2 messageType value = #condition]]!

Item was added:
+ ----- Method: BraceNode>>isTopStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmt: t1 
+ 	t1 = nil
+ 		ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: BraceNode>>rcvr: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr: t1 
+ 	^ t1!

Item was added:
+ ----- Method: BraceNode>>replaceNode:with: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ replaceNode: childNode with: newNode
+ 
+ 	| index |
+ 	(index _ elements indexOf: childNode) > 0
+ 		ifTrue: [elements at: index put: newNode.].
+ !

Item was added:
+ ----- Method: BraceNode>>thisNode (in category '*Etoys-Tweak-Kedama-Generated') -----
+ thisNode
+ 	^ self!

Item was added:
+ ----- Method: BraceNode>>transfer: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 
+ 	^ t1!

Item was added:
+ ----- Method: BraceNode>>visitBy: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ visitBy: visitor
+ 
+ 	visitor visit: self.
+ 	elements do: [:a | a visitBy: visitor].
+ !

Item was added:
+ Morph subclass: #BroomMorph
+ 	instanceVariableNames: 'centered drawBroomIcon filter hotspot lastHotspot moved span start transient unmoved width'
+ 	classVariableNames: 'BroomIcon'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-BroomMorphs-Base'!
+ 
+ !BroomMorph commentStamp: 'nk 7/24/2003 15:15' prior: 0!
+ This is a Morph (actually a family of Morphs) that do alignment of other morphs.
+ 
+ BroomMorphs become: an object of one of their subclasses when dragged far enough.
+ 
+ Drag a BroomMorph in some direction and it becomes a broom that can align the Morphs it touches.
+ 
+ This idea is borrowed from the GEF framework (http://gef.tigris.org)
+ 
+ If you want to pick up a BroomMorph, you can use the Shift key.
+ 
+ Hitting the ESC key will re-position all moved Morphs to their original position.
+ 
+ BroomMorph newTransient will give you a BroomMorph that will delete itself on mouse up.
+ 
+ unmoved	the set of Morphs that I won't move
+ moved		the set of Morphs that I might move
+ start		my first hotspot
+ span		how wide to make (each half of) my bar initially
+ width		the width of the main lines
+ hotspot		my active position
+ lastHotspot	my last active position
+ drawBroomIcon	true if I look like a broom while idle (false=look like a +)
+ transient	if true, then I delete myself on mouse-up
+ !

Item was added:
+ ----- Method: BroomMorph class>>broomIcon (in category 'icons') -----
+ broomIcon
+ 	"BroomMorph broomIcon openAsMorph"
+ 	^BroomIcon ifNil: [ BroomIcon _ ((ColorForm
+ 	extent: 48 at 48
+ 	depth: 8
+ 	fromArray: #( 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294965235 2123104255 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294289468 792571391 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4250474910 4268775935 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4281003980 4040445339 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 3558577510 3456013868 3305111551 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4119016581 1223753318 1509949439 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294325096 1601695446 905969663 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294953525 2688143356 2354708479 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967163 1386041086 3779953919 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967294 730230149 4272828159 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4280259150 3556661084 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4284369021 1626460469 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294927207 1420492426 1308622847 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294937190 2120285430 1165885439 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294957119 1936237296 3090939903 4294967295 4294967295 4294967295 1314410239 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 980114393 4199311359 4294967295 4294967295 4294922751 3468260930 1409286143 4294967295 4294967295 4294967295 4294967295 4294967295 1985634676 4278069247 4294967295 4294967295 822072038 4259577561 1764753407 4294967295 4294967295 4294967295 4294967295 4294967295 3629150295 2650507588 4294967295 4294915958 3355115262 4143841013 4272170751 4294967295 4294967295 4294967295 4294967295 4294967295 4294926694 1526660645 2147418111 811775466 4278123248 4110024186 4209802495 4294967295 4294967295 4294967295 4294967295 4294967295 4291518587 1401683663 331415327 2949970174 4142920702 4261016571 4278113279 4294967295 4294967295 4294967295 4294967295 4294967295 4294967126 2521018110 1564595145 4177130745 4177394940 4226481918 3875468850 4294967295 4294967295 4294967295 4294967295 4294967295 4294966641 1818781950 4128018932 4227464691 4260888054 4193844470 4278022746 4294967295 4294967295 4294967295 4294967295 4294967295 4294957251 1082604973 4103079930 4227659000 4260949757 4260625918 4151583689 4294967295 4294967295 4294967295 4294967295 4294967295 4294966523 2254399056 4275306750 4259969533 4126735860 4160027632 1714067961 4294967295 4294967295 4294967295 4294967295 4294967295 3774129236 3427224966 2232244218 4009623029 4143840757 4227709222 1704204739 4294967295 4294967295 4294967295 4294967295 4294967281 3329305219 4274147615 459535614 4261278453 4260753150 4270732152 2132872703 4294967295 4294967295 4294967295 4294967295 4294966951 995344887 3891984632 4244567550 4260690427 4076796361 1799391336 17564460 4294967295 4294967295 4294967295 4294967295 4274153014 2180382453 4261084157 4175822318 4059954686 4277316954 1602381320 643309831 4294967295 4294967295 4294967295 4294967282 2823377603 3942511613 4142661107 4260624381 4261016062 4052699741 2049901056 391839597 4294967295 4294967295 4294967295 4294894196 747109878 4260689915 4210947065 4260953586 4177395136 1851158651 553648145 1599406079 4294967295 4294967295 4294967295 4256715083 3203923193 4177133041 4210883322 4244305914 4244547905 1487161345 330496 2227240959 4294967295 4294967295 4294967295 4280716212 4160615158 4244110584 4261214970 4261280247 4135604607 2017591306 728003705 1908998143 4294967295 4294967295 4294967257 2301731170 4093376766 4277467390 4259968509 3959291337 1415802972 571015178 360829128 4294967295 4294967295 4294967295 4294967254 1790591001 4244501995 4093310961 4160159230 4126914352 2004436244 50331652 659736575 4294967295 4294967295 4294967295 4294967238 1761476611 2144730878 4160683517 4143772670 4203101036 1849950720 34150400 1526726655 4294967295 4294967295 4294967295 4294967245 1806603524 512422141 4177326578 4261346478 1567853403 419430418 27790 2499805183 4294967295 4294967295 4294967295 4294967295 2251944828 416179 4143369424 4142962521 2121937418 218103943 3075177727 4294967295 4294967295 4294967295 4294967295 4294967295 4030225866 2973499918 708410107 3394655628 1595344640 292229396 3218276351 4294967295 4294967295 4294967295 4294967295 3741319167 4292174133 2024384681 2646072943 1099787826 335808768 24831321 1996488703 4294967295 4294967295 4294967295 4294967295 4294967295 4294960585 1731939648 1162880122 2488537608 262165 842649087 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967246 4257768094 2930289509 420675584 173165056 1442840575 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4291847681 17632000 100663398 1027537151 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4290903836 152109071 5575935 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294954239 1392579628 436207615 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295 4294967295)
+ 	offset: 0 at 0)
+ 	colorsFromArray: #(#(0.0 0.0 0.0) #(0.004 0.004 0.004) #(0.008 0.008 0.008) #(0.012 0.012 0.012) #(0.016 0.016 0.016) #(0.02 0.02 0.02) #(0.023 0.023 0.023) #(0.027 0.027 0.027) #(0.031 0.031 0.031) #(0.035 0.035 0.035) #(0.039 0.039 0.039) #(0.043 0.043 0.043) #(0.047 0.047 0.047) #(0.051 0.051 0.051) #(0.055 0.055 0.055) #(0.059 0.059 0.059) #(0.063 0.063 0.063) #(0.066 0.066 0.066) #(0.07 0.07 0.07) #(0.074 0.074 0.074) #(0.078 0.078 0.078) #(0.082 0.082 0.082) #(0.086 0.086 0.086) #(0.09 0.09 0.09) #(0.094 0.094 0.094) #(0.098 0.098 0.098) #(0.102 0.102 0.102) #(0.106 0.106 0.106) #(0.109 0.109 0.109) #(0.113 0.113 0.113) #(0.117 0.117 0.117) #(0.121 0.121 0.121) #(0.125 0.125 0.125) #(0.129 0.129 0.129) #(0.133 0.133 0.133) #(0.137 0.137 0.137) #(0.141 0.141 0.141) #(0.145 0.145 0.145) #(0.149 0.149 0.149) #(0.152 0.152 0.152) #(0.156 0.156 0.156) #(0.16 0.16 0.16) #(0.164 0.164 0.164) #(0.168 0.168 0.168) #(0.172 0.172 0.172) #(0.176 0.176 0.176) #(0.18 0.18 0.18) #(0.184 0.184 0.184) #(0.188 0.188 0.188) #(0.192 0.192 0.192) #(0.196 0.196 0.196) #(0.199 0.199 0.199) #(0.203 0.203 0.203) #(0.207 0.207 0.207) #(0.211 0.211 0.211) #(0.215 0.215 0.215) #(0.219 0.219 0.219) #(0.223 0.223 0.223) #(0.227 0.227 0.227) #(0.231 0.231 0.231) #(0.235 0.235 0.235) #(0.239 0.239 0.239) #(0.242 0.242 0.242) #(0.246 0.246 0.246) #(0.25 0.25 0.25) #(0.254 0.254 0.254) #(0.258 0.258 0.258) #(0.262 0.262 0.262) #(0.266 0.266 0.266) #(0.27 0.27 0.27) #(0.274 0.274 0.274) #(0.278 0.278 0.278) #(0.282 0.282 0.282) #(0.285 0.285 0.285) #(0.289 0.289 0.289) #(0.293 0.293 0.293) #(0.297 0.297 0.297) #(0.301 0.301 0.301) #(0.305 0.305 0.305) #(0.309 0.309 0.309) #(0.313 0.313 0.313) #(0.317 0.317 0.317) #(0.321 0.321 0.321) #(0.325 0.325 0.325) #(0.328 0.328 0.328) #(0.333 0.333 0.333) #(0.337 0.337 0.337) #(0.341 0.341 0.341) #(0.345 0.345 0.345) #(0.349 0.349 0.349) #(0.353 0.353 0.353) #(0.357 0.357 0.357) #(0.361 0.361 0.361) #(0.365 0.365 0.365) #(0.369 0.369 0.369) #(0.372 0.372 0.372) #(0.376 0.376 0.376) #(0.38 0.38 0.38) #(0.384 0.384 0.384) #(0.388 0.388 0.388) #(0.392 0.392 0.392) #(0.396 0.396 0.396) #(0.4 0.4 0.4) #(0.404 0.404 0.404) #(0.408 0.408 0.408) #(0.412 0.412 0.412) #(0.415 0.415 0.415) #(0.419 0.419 0.419) #(0.423 0.423 0.423) #(0.427 0.427 0.427) #(0.431 0.431 0.431) #(0.435 0.435 0.435) #(0.439 0.439 0.439) #(0.443 0.443 0.443) #(0.447 0.447 0.447) #(0.451 0.451 0.451) #(0.455 0.455 0.455) #(0.458 0.458 0.458) #(0.462 0.462 0.462) #(0.466 0.466 0.466) #(0.47 0.47 0.47) #(0.474 0.474 0.474) #(0.478 0.478 0.478) #(0.482 0.482 0.482) #(0.486 0.486 0.486) #(0.49 0.49 0.49) #(0.494 0.494 0.494) #(0.498 0.498 0.498) #(0.501 0.501 0.501) #(0.505 0.505 0.505) #(0.509 0.509 0.509) #(0.513 0.513 0.513) #(0.517 0.517 0.517) #(0.521 0.521 0.521) #(0.525 0.525 0.525) #(0.529 0.529 0.529) #(0.533 0.533 0.533) #(0.537 0.537 0.537) #(0.541 0.541 0.541) #(0.544 0.544 0.544) #(0.548 0.548 0.548) #(0.552 0.552 0.552) #(0.556 0.556 0.556) #(0.56 0.56 0.56) #(0.564 0.564 0.564) #(0.568 0.568 0.568) #(0.572 0.572 0.572) #(0.576 0.576 0.576) #(0.58 0.58 0.58) #(0.584 0.584 0.584) #(0.587 0.587 0.587) #(0.591 0.591 0.591) #(0.595 0.595 0.595) #(0.599 0.599 0.599) #(0.603 0.603 0.603) #(0.607 0.607 0.607) #(0.611 0.611 0.611) #(0.615 0.615 0.615) #(0.619 0.619 0.619) #(0.623 0.623 0.623) #(0.627 0.627 0.627) #(0.63 0.63 0.63) #(0.634 0.634 0.634) #(0.638 0.638 0.638) #(0.642 0.642 0.642) #(0.646 0.646 0.646) #(0.65 0.65 0.65) #(0.654 0.654 0.654) #(0.658 0.658 0.658) #(0.662 0.662 0.662) #(0.667 0.667 0.667) #(0.671 0.671 0.671) #(0.674 0.674 0.674) #(0.678 0.678 0.678) #(0.682 0.682 0.682) #(0.686 0.686 0.686) #(0.69 0.69 0.69) #(0.694 0.694 0.694) #(0.698 0.698 0.698) #(0.702 0.702 0.702) #(0.706 0.706 0.706) #(0.71 0.71 0.71) #(0.714 0.714 0.714) #(0.717 0.717 0.717) #(0.721 0.721 0.721) #(0.725 0.725 0.725) #(0.729 0.729 0.729) #(0.733 0.733 0.733) #(0.737 0.737 0.737) #(0.741 0.741 0.741) #(0.745 0.745 0.745) #(0.749 0.749 0.749) #(0.753 0.753 0.753) #(0.757 0.757 0.757) #(0.761 0.761 0.761) #(0.764 0.764 0.764) #(0.768 0.768 0.768) #(0.772 0.772 0.772) #(0.776 0.776 0.776) #(0.78 0.78 0.78) #(0.784 0.784 0.784) #(0.788 0.788 0.788) #(0.792 0.792 0.792) #(0.796 0.796 0.796) #(0.8 0.8 0.8) #(0.804 0.804 0.804) #(0.807 0.807 0.807) #(0.811 0.811 0.811) #(0.815 0.815 0.815) #(0.819 0.819 0.819) #(0.823 0.823 0.823) #(0.827 0.827 0.827) #(0.831 0.831 0.831) #(0.835 0.835 0.835) #(0.839 0.839 0.839) #(0.843 0.843 0.843) #(0.847 0.847 0.847) #(0.85 0.85 0.85) #(0.854 0.854 0.854) #(0.858 0.858 0.858) #(0.862 0.862 0.862) #(0.866 0.866 0.866) #(0.87 0.87 0.87) #(0.874 0.874 0.874) #(0.878 0.878 0.878) #(0.882 0.882 0.882) #(0.886 0.886 0.886) #(0.89 0.89 0.89) #(0.893 0.893 0.893) #(0.897 0.897 0.897) #(0.901 0.901 0.901) #(0.905 0.905 0.905) #(0.909 0.909 0.909) #(0.913 0.913 0.913) #(0.917 0.917 0.917) #(0.921 0.921 0.921) #(0.925 0.925 0.925) #(0.929 0.929 0.929) #(0.933 0.933 0.933) #(0.936 0.936 0.936) #(0.94 0.94 0.94) #(0.944 0.944 0.944) #(0.948 0.948 0.948) #(0.952 0.952 0.952) #(0.956 0.956 0.956) #(0.96 0.96 0.96) #(0.964 0.964 0.964) #(0.968 0.968 0.968) #(0.972 0.972 0.972) #(0.976 0.976 0.976) #(0.979 0.979 0.979) #(0.983 0.983 0.983) #(0.987 0.987 0.987) #(0.991 0.991 0.991) #(0.995 0.995 0.995) #( )  )) ]!

Item was added:
+ ----- Method: BroomMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName: 	'Broom' translatedNoop
+ 		categories:		{'Graphics' translatedNoop}
+ 		documentation:	'A broom to align Morphs with' translatedNoop!

Item was added:
+ ----- Method: BroomMorph class>>newCentered (in category 'instance creation') -----
+ newCentered
+ 	"return a BroomMorph that will align Morph centers"
+ 	"BroomMorph newCentered openInHand"
+ 	^(self new) centered: true!

Item was added:
+ ----- Method: BroomMorph class>>newTransient (in category 'instance creation') -----
+ newTransient
+ 	"return a BroomMorph that will delete itself on mouse-up"
+ 
+ 	"BroomMorph newTransient openInHand"
+ 
+ 	^self new transient: true!

Item was added:
+ ----- Method: BroomMorph class>>newTransientInHand (in category 'instance creation') -----
+ newTransientInHand
+ 
+ 	"return a BroomMorph that will delete itself on mouse-up"
+ 
+ 	"BroomMorph newTransientInHand"
+ 
+ 	^self newTransient openInHand!

Item was added:
+ ----- Method: BroomMorph>>affectedMorphs (in category 'private') -----
+ affectedMorphs
+ 	"Answer all the morphs that I should be moving"
+ 	^ #()!

Item was added:
+ ----- Method: BroomMorph>>basicClass (in category 'private') -----
+ basicClass
+ 	^BroomMorph!

Item was added:
+ ----- Method: BroomMorph>>centered: (in category 'accessing') -----
+ centered: aBoolean
+ 	"If aBoolean is true, I align morphs on their H or V centerlines"
+ 	centered _ aBoolean.!

Item was added:
+ ----- Method: BroomMorph>>drawBroomIcon: (in category 'accessing') -----
+ drawBroomIcon: aBoolean
+ 	"If aBoolean is true, then I draw a cute broom icon; otherwise I draw a cross"
+ 	drawBroomIcon _ aBoolean.
+ 	self changed.!

Item was added:
+ ----- Method: BroomMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 	drawBroomIcon
+ 		ifTrue: [ aCanvas paintImage: self class broomIcon at: self position ]
+ 		ifFalse: [ self drawPlusOn: aCanvas ].
+ !

Item was added:
+ ----- Method: BroomMorph>>drawPlusOn: (in category 'drawing') -----
+ drawPlusOn: aCanvas
+ 	| halfWidth |
+ 	halfWidth _ width + 1 // 2.
+ 	aCanvas line: bounds leftCenter + (halfWidth at 0) to: bounds rightCenter + (halfWidth negated at 0) width: width color: self color.
+ 	aCanvas line: bounds topCenter + (0 at halfWidth) to: bounds bottomCenter + (0 at halfWidth negated) width: width color: self color.
+ !

Item was added:
+ ----- Method: BroomMorph>>filter: (in category 'accessing') -----
+ filter: aBlock
+ 	"Set my acceptance filter. aBlock should return true for all Morphs to be moved"
+ 	filter _ aBlock fixTemps!

Item was added:
+ ----- Method: BroomMorph>>handlesKeyboard: (in category 'event handling') -----
+ handlesKeyboard: evt
+ 	^true!

Item was added:
+ ----- Method: BroomMorph>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: evt
+ 	^evt shiftPressed not!

Item was added:
+ ----- Method: BroomMorph>>handlesMouseStillDown: (in category 'event handling') -----
+ handlesMouseStillDown: evt
+ 	^true.!

Item was added:
+ ----- Method: BroomMorph>>hotspot (in category 'accessing') -----
+ hotspot
+ 	^hotspot!

Item was added:
+ ----- Method: BroomMorph>>hotspot: (in category 'private') -----
+ hotspot: aPoint
+ 	lastHotspot _ hotspot.
+ 	hotspot _ aPoint.
+ 	^self center: aPoint!

Item was added:
+ ----- Method: BroomMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	super initialize.
+ 	width _ 5.
+ 	span _ 100.
+ 	hotspot _ self center.
+ 	self reset.
+ 	self color: Color blue muchDarker.
+ 	self setBalloonText: 'Drag me to align other Morphs. Drag with the Shift key to move me without affecting other Morphs. Drag me with the second mouse button to align centers.' translated.
+ 	drawBroomIcon _ true.
+ 	transient _ false.
+ 	centered _ false.
+ !

Item was added:
+ ----- Method: BroomMorph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
+ justDroppedInto: aMorph event: anEvent
+ 	super justDroppedInto: aMorph event: anEvent.
+ 	aMorph isPlayfieldLike ifFalse: [ ^self delete ].
+ 	self centered: anEvent hand lastEvent yellowButtonPressed.
+ 	self transient ifFalse: [ ^self ].
+ 		self reset.
+ 		self hotspot: (start _ anEvent position).
+ 		anEvent hand mouseFocus: self.
+ 		anEvent hand keyboardFocus: self.
+ 		"Cursor blank show."!

Item was added:
+ ----- Method: BroomMorph>>keyStroke: (in category 'event handling') -----
+ keyStroke: evt
+ 	evt keyCharacter ~= Character escape ifTrue: [ ^self ].
+ 	evt hand releaseMouseFocus: self.
+ 	evt hand releaseKeyboardFocus: self.
+ 	Cursor normal show.
+ 	moved keysAndValuesDo: [ :m :b | m bounds: b ].
+ 	transient ifTrue: [ ^self delete ].
+ 	self resetClass.
+ 	self reset.
+ 	self hotspot: start.
+ !

Item was added:
+ ----- Method: BroomMorph>>lineWidth (in category 'accessing') -----
+ lineWidth
+ 	^width!

Item was added:
+ ----- Method: BroomMorph>>lineWidth: (in category 'accessing') -----
+ lineWidth: aNumber
+ 	width _ aNumber.
+ 	self changed!

Item was added:
+ ----- Method: BroomMorph>>morphIfNecessary: (in category 'stepping and presenter') -----
+ morphIfNecessary: yellowButtonPressed
+ 	| pt delta threshold cls center |
+ 	center _ yellowButtonPressed | centered.
+ 	pt _ self center.
+ 	threshold _ self width / 2.
+ 	delta _ pt - start.
+ 	cls _ delta x > threshold
+ 				ifTrue: [center
+ 						ifTrue: [CenterBroomMorphRight]
+ 						ifFalse: [BroomMorphRight]]
+ 				ifFalse: [delta x < threshold negated
+ 						ifTrue: [center
+ 								ifTrue: [CenterBroomMorphLeft]
+ 								ifFalse: [BroomMorphLeft]]
+ 						ifFalse: [delta y > threshold
+ 								ifTrue: [center
+ 										ifTrue: [CenterBroomMorphDown]
+ 										ifFalse: [BroomMorphDown]]
+ 								ifFalse: [delta y < threshold negated
+ 										ifTrue: [center
+ 												ifTrue: [CenterBroomMorphUp]
+ 												ifFalse: [BroomMorphUp]]]]].
+ 	cls
+ 		ifNotNil: [self
+ 				become: (self as: cls).
+ 			self reset.
+ 			self resetFilter.
+ 			unmoved addAll: self affectedMorphs]!

Item was added:
+ ----- Method: BroomMorph>>mouseDown: (in category 'event handling') -----
+ mouseDown: evt
+ 	self reset.
+ 	self resetFilter.
+ 	self hotspot: (start _ evt position).
+ 	evt hand mouseFocus: self.
+ 	evt hand keyboardFocus: self.
+ 	"Cursor blank show."!

Item was added:
+ ----- Method: BroomMorph>>mouseMove: (in category 'event handling') -----
+ mouseMove: evt
+ 	self hotspot: evt position.
+ 	self moveMorphs: evt yellowButtonPressed!

Item was added:
+ ----- Method: BroomMorph>>mouseStillDown: (in category 'event handling') -----
+ mouseStillDown: evt
+ 	self hotspot: evt position.
+ 	self moveMorphs: evt yellowButtonPressed!

Item was added:
+ ----- Method: BroomMorph>>mouseUp: (in category 'event handling') -----
+ mouseUp: evt 
+ 	evt hand releaseMouseFocus: self.
+ 	Cursor normal show.
+ 	self rememberCommand: self undoCommand.
+ 	transient ifTrue: [ ^self delete ].
+ 	self resetClass.
+ 	self reset.
+ 	self hotspot: start.!

Item was added:
+ ----- Method: BroomMorph>>moveMorphs: (in category 'stepping and presenter') -----
+ moveMorphs: yellowButtonPressed
+ 	"Move all the newly affected morphs and the ones I'm already moving."
+ 	self class == self basicClass
+ 		ifTrue: [^ self morphIfNecessary: yellowButtonPressed ].
+ 	(((self affectedMorphs
+ 		reject: [:m | unmoved includes: m])
+ 		reject: [:m | moved includesKey: m])
+ 		select: filter)
+ 		do: [:m | moved at: m put: m bounds].
+ 	moved
+ 		keysAndValuesDo: [:m :b | self positionMorph: m originalBounds: b]!

Item was added:
+ ----- Method: BroomMorph>>openCenteredInHand (in category 'initialization') -----
+ openCenteredInHand
+ 	"BroomMorph new openCenteredInHand"
+ 	"NCBroomMorph new openCenteredInHand"
+ 	self centered: true.
+ 	self openInHand.!

Item was added:
+ ----- Method: BroomMorph>>openTransientCenteredInHand (in category 'initialization') -----
+ openTransientCenteredInHand
+ 	"BroomMorph new openTransientCenteredInHand"
+ 	self transient: true.
+ 	self centered: true.
+ 	self openInHand.!

Item was added:
+ ----- Method: BroomMorph>>openTransientInHand (in category 'initialization') -----
+ openTransientInHand
+ 	"BroomMorph new openTransientInHand"
+ 	self transient: true.
+ 	self openInHand.!

Item was added:
+ ----- Method: BroomMorph>>reset (in category 'initialization') -----
+ reset
+ 	moved _ IdentityDictionary new.		"morph -> original bounds"
+ 	unmoved _ IdentitySet new.
+ 	self resetExtent.
+ 	filter _ nil.
+ !

Item was added:
+ ----- Method: BroomMorph>>resetClass (in category 'initialization') -----
+ resetClass
+ 	self become: (self as: self basicClass)!

Item was added:
+ ----- Method: BroomMorph>>resetExtent (in category 'initialization') -----
+ resetExtent
+ 	super extent: self class broomIcon extent.
+ 	hotspot _ lastHotspot _ self center.!

Item was added:
+ ----- Method: BroomMorph>>resetFilter (in category 'initialization') -----
+ resetFilter
+ 
+ 	self filter: [ :m | true ].
+ !

Item was added:
+ ----- Method: BroomMorph>>span (in category 'accessing') -----
+ span
+ 	^span!

Item was added:
+ ----- Method: BroomMorph>>span: (in category 'accessing') -----
+ span: aNumber
+ 	span _ aNumber.
+ 	self hotspot: self hotspot.
+ 	self changed.!

Item was added:
+ ----- Method: BroomMorph>>transient (in category 'accessing') -----
+ transient
+ 	^transient!

Item was added:
+ ----- Method: BroomMorph>>transient: (in category 'accessing') -----
+ transient: aBoolean
+ 	"if aBoolean is true, then I delete myself on mouse-up"
+ 	transient _ aBoolean!

Item was added:
+ ----- Method: BroomMorph>>undoCommand (in category 'undo') -----
+ undoCommand
+ 	| cmd args |
+ 	cmd _ Command new cmdWording: 'align morphs'.
+ 	args _ OrderedCollection new.
+ 	moved keysAndValuesDo: [ :m :b |
+ 		args add: { m. b. m bounds. m owner. m owner morphPreceding: m }
+ 	].
+ 	cmd undoTarget: self selector: #undoMove:redo:args: arguments: { cmd. false. args }.
+ 	^cmd!

Item was added:
+ ----- Method: BroomMorph>>undoMove:redo:args: (in category 'undo') -----
+ undoMove: cmd redo: redo args: args
+ 	"morph oldbounds newbounds oldowner oldpredecessor"
+ 	cmd redoTarget: self selector: #undoMove:redo:args: arguments: { cmd. true. args }.
+ 	args do: [ :a | | morph oldbounds newbounds oldowner oldpredecessor |
+ 		morph _ a at: 1.
+ 		oldbounds _ a at: 2.
+ 		newbounds _ a at: 3.
+ 		oldowner _ a at: 4.
+ 		oldpredecessor _ a at: 5.
+ 		oldowner ifNotNil: [ oldpredecessor ifNil: [ oldowner addMorphFront: morph ]
+ 			ifNotNil: [ oldowner addMorph: morph after: oldpredecessor ]].
+ 		morph bounds: (redo ifTrue: [ newbounds ] ifFalse: [ oldbounds ]).
+ 		(morph isKindOf: SystemWindow) ifTrue: [ morph activate ].
+ 	].!

Item was added:
+ BroomMorph subclass: #BroomMorphDown
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-BroomMorphs-Base'!
+ 
+ !BroomMorphDown commentStamp: '<historical>' prior: 0!
+ I am a BroomMorph that pushes morphs down.!

Item was added:
+ ----- Method: BroomMorphDown>>affectedMorphs (in category 'private') -----
+ affectedMorphs
+ 	"Answer all the morphs that I should be moving"
+ 	| movedRect |
+ 	movedRect _ self bounds encompass: hotspot x @ lastHotspot y.
+ 	^ owner submorphs
+ 		select: [:m | movedRect
+ 				intersects: (Rectangle
+ 						left: m bounds left
+ 						right: m bounds right
+ 						top: m bounds top
+ 						bottom: m bounds top + 1)]!

Item was added:
+ ----- Method: BroomMorphDown>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 	| halfWidth |
+ 	halfWidth _ width + 1 // 2.
+ 	aCanvas line: bounds topCenter + (0 at halfWidth) to: bounds bottomCenter + (0 at halfWidth negated) width: width color: self color.
+ 	aCanvas line: bounds bottomLeft + (halfWidth @ halfWidth negated) to: bounds bottomRight + (halfWidth negated at halfWidth negated) width: width color: self color.
+ 	aCanvas line: self hotspot + (span negated @ (width * -2)) to: self hotspot + (span negated @ -1) color: self color.
+ 	aCanvas line: self hotspot + (span -1 @ (width * -2)) to: self hotspot + (span-1 @ -1) color: self color.
+ !

Item was added:
+ ----- Method: BroomMorphDown>>hotspot: (in category 'accessing') -----
+ hotspot: aPoint 
+ 	| left right bottom newBounds |
+ 	left _ aPoint x - span min: bounds left.
+ 	right _ aPoint x + span max: bounds right.
+ 	bottom _ aPoint y max: start y.
+ 	lastHotspot _ hotspot.
+ 	hotspot _ aPoint x @ bottom.
+ 	newBounds _ Rectangle
+ 				left: left
+ 				right: right
+ 				top: bottom - bounds height
+ 				bottom: bottom.
+ 	self bounds: newBounds.
+ !

Item was added:
+ ----- Method: BroomMorphDown>>positionMorph:originalBounds: (in category 'private') -----
+ positionMorph: m originalBounds: b
+ 	m top: (self bottom max: b top)!

Item was added:
+ ----- Method: BroomMorphDown>>resetExtent (in category 'drawing') -----
+ resetExtent
+ 	| newBounds |
+ 	newBounds _ 0 at 0 extent: (2*span) @ (12 + width).
+ 	self bounds: (newBounds align: newBounds bottomCenter with: hotspot)!

Item was added:
+ BroomMorphRight subclass: #BroomMorphLeft
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-BroomMorphs-Base'!
+ 
+ !BroomMorphLeft commentStamp: '<historical>' prior: 0!
+ I am a BroomMorph that pushes morphs left.!

Item was added:
+ ----- Method: BroomMorphLeft>>affectedMorphs (in category 'private') -----
+ affectedMorphs
+ 	"Answer all the morphs that I should be moving"
+ 	| movedRect |
+ 	movedRect _ self bounds encompass: lastHotspot x @ hotspot y.
+ 	^ owner submorphs
+ 		select: [:m | movedRect
+ 				intersects: (Rectangle
+ 						left: m bounds right - 1
+ 						right: m bounds right
+ 						top: m bounds top
+ 						bottom: m bounds bottom)]!

Item was added:
+ ----- Method: BroomMorphLeft>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 	| halfWidth |
+ 	halfWidth _ (width + 1 // 2).
+ 	aCanvas line: bounds leftCenter + (halfWidth at 0) to: bounds rightCenter + (halfWidth negated @0) width: width color: self color.
+ 	aCanvas line: bounds topLeft + (halfWidth @ halfWidth) to: bounds bottomLeft + (halfWidth @halfWidth  negated) width: width color: self color.
+ 	aCanvas line: self hotspot + (width * 2 @ (span negated)) to: self hotspot + (1 @ (span negated)) color: self color.
+ 	aCanvas line: self hotspot + (width * 2 @ (span-1)) to: self hotspot + (1 @ (span-1)) color: self color.
+ !

Item was added:
+ ----- Method: BroomMorphLeft>>hotspot: (in category 'accessing') -----
+ hotspot: aPoint 
+ 	| newBounds top bottom left |
+ 	top _ aPoint y - span min: bounds top.
+ 	bottom _ aPoint y + span max: bounds bottom.
+ 	left _ aPoint x min: start x.
+ 	lastHotspot _ hotspot.
+ 	hotspot _ left @ aPoint y.
+ 	newBounds _ Rectangle
+ 				left: left
+ 				right: left  + bounds width
+ 				top: top
+ 				bottom: bottom.
+ 	self bounds: newBounds!

Item was added:
+ ----- Method: BroomMorphLeft>>positionMorph:originalBounds: (in category 'private') -----
+ positionMorph: m originalBounds: b
+ 	m right: (self left min: b right)!

Item was added:
+ ----- Method: BroomMorphLeft>>resetExtent (in category 'drawing') -----
+ resetExtent
+ 	| newBounds |
+ 	newBounds _ 0 at 0 extent: (12 + width) @ (2*span).
+ 	self bounds: (newBounds align: newBounds leftCenter with: hotspot)!

Item was added:
+ BroomMorph subclass: #BroomMorphRight
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-BroomMorphs-Base'!
+ 
+ !BroomMorphRight commentStamp: '<historical>' prior: 0!
+ I am a BroomMorph that pushes morphs right.!

Item was added:
+ ----- Method: BroomMorphRight>>affectedMorphs (in category 'private') -----
+ affectedMorphs
+ 	"Answer all the morphs that I should be moving"
+ 	| movedRect |
+ 	movedRect _ self bounds encompass: lastHotspot x @ hotspot y.
+ 	^ owner submorphs
+ 		select: [:m | movedRect
+ 				intersects: (Rectangle
+ 						left: m bounds left
+ 						right: m bounds left + 1
+ 						top: m bounds top
+ 						bottom: m bounds bottom)]!

Item was added:
+ ----- Method: BroomMorphRight>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 	| halfWidth |
+ 	halfWidth _ width + 1 // 2.
+ 	aCanvas line: bounds leftCenter + (halfWidth at 0) to: bounds rightCenter + (halfWidth negated @0) width: width color: self color.
+ 	aCanvas line: bounds topRight + (halfWidth negated @ halfWidth) to: bounds bottomRight + (halfWidth negated at halfWidth negated) width: width color: self color.
+ 	aCanvas line: self hotspot + (width * -2 @ (span negated)) to: self hotspot + (-1 @ (span negated)) color: self color.
+ 	aCanvas line: self hotspot + (width * -2 @ (span-1)) to: self hotspot + (-1 @ (span-1)) color: self color.
+ !

Item was added:
+ ----- Method: BroomMorphRight>>hotspot: (in category 'accessing') -----
+ hotspot: aPoint 
+ 	| newBounds top bottom right |
+ 	top _ aPoint y - span min: bounds top.
+ 	bottom _ aPoint y + span max: bounds bottom.
+ 	right _ aPoint x max: start x.
+ 	lastHotspot _ hotspot.
+ 	hotspot _ right @ aPoint y.
+ 	newBounds _ Rectangle
+ 				left: right - bounds width
+ 				right: right
+ 				top: top
+ 				bottom: bottom.
+ 	self bounds: newBounds!

Item was added:
+ ----- Method: BroomMorphRight>>positionMorph:originalBounds: (in category 'private') -----
+ positionMorph: m originalBounds: b
+ 	m left: (self right max: b left)!

Item was added:
+ ----- Method: BroomMorphRight>>resetExtent (in category 'accessing') -----
+ resetExtent
+ 	| newBounds |
+ 	newBounds _ 0 at 0 extent: (12 + width) @ (2*span).
+ 	self bounds: (newBounds align: newBounds rightCenter with: hotspot)!

Item was added:
+ BroomMorphDown subclass: #BroomMorphUp
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-BroomMorphs-Base'!
+ 
+ !BroomMorphUp commentStamp: '<historical>' prior: 0!
+ I am a BroomMorph that pushes morphs up.!

Item was added:
+ ----- Method: BroomMorphUp>>affectedMorphs (in category 'private') -----
+ affectedMorphs
+ 	"Answer all the morphs that I should be moving"
+ 	| movedRect |
+ 	movedRect _ self bounds encompass: hotspot x @ lastHotspot y.
+ 	^ owner submorphs
+ 		select: [:m | movedRect
+ 				intersects: (Rectangle
+ 						left: m bounds left
+ 						right: m bounds right
+ 						top: m bounds bottom - 1
+ 						bottom: m bounds bottom)]!

Item was added:
+ ----- Method: BroomMorphUp>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 	| halfWidth |
+ 	halfWidth _ width + 1 // 2.
+ 	aCanvas line: bounds topCenter + (0 at halfWidth) to: bounds bottomCenter + (0 at halfWidth negated) width: width color: self color.
+ 	aCanvas line: bounds topLeft + (halfWidth @ halfWidth) to: bounds topRight + ((halfWidth) negated at halfWidth) width: width color: self color.
+ 	aCanvas line: self hotspot + (span negated @ (width * 2)) to: self hotspot + (span negated @ 1) color: self color.
+ 	aCanvas line: self hotspot + (span -1 @ (width * 2)) to: self hotspot + (span -1 @ 1) color: self color.
+ !

Item was added:
+ ----- Method: BroomMorphUp>>hotspot: (in category 'accessing') -----
+ hotspot: aPoint 
+ 	| left right newBounds top |
+ 	left _ aPoint x - span min: bounds left.
+ 	right _ aPoint x + span max: bounds right.
+ 	top _ aPoint y min: start y.
+ 	lastHotspot _ hotspot.
+ 	hotspot _ aPoint x @ top.
+ 	newBounds _ Rectangle
+ 				left: left
+ 				right: right
+ 				top: top
+ 				bottom: top + bounds height.
+ 	self bounds: newBounds!

Item was added:
+ ----- Method: BroomMorphUp>>positionMorph:originalBounds: (in category 'private') -----
+ positionMorph: m originalBounds: b
+ 	m bottom: (self top min: b bottom)!

Item was added:
+ ----- Method: BroomMorphUp>>resetExtent (in category 'drawing') -----
+ resetExtent
+ 	| newBounds |
+ 	newBounds _ 0 at 0 extent: (2*span) @ (12 + width).
+ 	self bounds: (newBounds align: newBounds topCenter with: hotspot)!

Item was added:
+ ----- Method: Browser>>browserWindowActivated (in category '*Etoys-Squeakland-initialize-release') -----
+ browserWindowActivated
+ 	"Called when a window whose model is the receiver is reactivated, giving the receiver an opportunity to take steps if it wishes.  The default is to do nothing.  8/5/96 sw"!

Item was added:
+ ----- Method: Browser>>buildClassBrowser (in category '*Etoys-Squeakland-class functions') -----
+ buildClassBrowser
+ 	"Create and schedule a new class category browser for the current class 
+ 	selection, if one exists."
+ 
+ 	self buildClassBrowserEditString: nil!

Item was added:
+ ----- Method: Browser>>buildMessageBrowser (in category '*Etoys-Squeakland-message functions') -----
+ buildMessageBrowser
+ 	"Create and schedule a message browser on the currently selected 
+ 	message. Do nothing if no message is selected. The initial text view 
+ 	contains nothing."
+ 
+ 	self buildMessageBrowserEditString: nil!

Item was added:
+ ----- Method: Browser>>overwriteDialogHierarchyChange:higher:sourceClassName:destinationClassName:methodSelector: (in category '*Etoys-Squeakland-drag and drop') -----
+ overwriteDialogHierarchyChange: hierarchyChange higher: higherFlag sourceClassName: srcClassName destinationClassName: dstClassName methodSelector: methodSelector 
+ 	| lf success |
+ 	lf _ Character cr asString.
+ 	success _ SelectionMenu
+ 				confirm: 'There is a conflict.' , ' Overwrite' , (hierarchyChange
+ 							ifTrue: [higherFlag
+ 									ifTrue: [' superclass']
+ 									ifFalse: [' subclass']]
+ 							ifFalse: ['']) , ' method' , lf , dstClassName , '>>' , methodSelector , lf , 'by ' , (hierarchyChange
+ 							ifTrue: ['moving']
+ 							ifFalse: ['copying']) , ' method' , lf , srcClassName name , '>>' , methodSelector , ' ?'
+ 				trueChoice: 'Yes, don''t care.'
+ 				falseChoice: 'No, I have changed my opinion.'.
+ 	^ success!

Item was added:
+ ----- Method: Browser>>toggleClassListIndex: (in category '*Etoys-Squeakland-class list') -----
+ toggleClassListIndex: anInteger 
+ 	"If anInteger is the current class index, deselect it. Else make it the 
+ 	current class selection."
+ 
+ 	self classListIndex: 
+ 		(classListIndex = anInteger
+ 			ifTrue: [0]
+ 			ifFalse: [anInteger])!

Item was added:
+ ----- Method: Browser>>toggleMessageCategoryListIndex: (in category '*Etoys-Squeakland-message category list') -----
+ toggleMessageCategoryListIndex: anInteger 
+ 	"If the currently selected message category index is anInteger, deselect 
+ 	the category. Otherwise select the category whose index is anInteger."
+ 
+ 	self messageCategoryListIndex: 
+ 		(messageCategoryListIndex = anInteger
+ 			ifTrue: [0]
+ 			ifFalse: [anInteger])!

Item was added:
+ ----- Method: Browser>>toggleMessageListIndex: (in category '*Etoys-Squeakland-message list') -----
+ toggleMessageListIndex: anInteger 
+ 	"If the currently selected message index is anInteger, deselect the message 
+ 	selector. Otherwise select the message selector whose index is anInteger."
+ 
+ 	self messageListIndex: 
+ 		(messageListIndex = anInteger
+ 			ifTrue: [0]
+ 			ifFalse: [anInteger])!

Item was added:
+ ----- Method: Browser>>toggleSystemCategoryListIndex: (in category '*Etoys-Squeakland-system category list') -----
+ toggleSystemCategoryListIndex: anInteger 
+ 	"If anInteger is the current system category index, deselect it. Else make 
+ 	it the current system category selection."
+ 
+ 	self systemCategoryListIndex: 
+ 		(systemCategoryListIndex = anInteger
+ 			ifTrue: [0]
+ 			ifFalse: [anInteger])!

Item was changed:
  ----- Method: ButtonProperties class>>defaultNameStemForInstances (in category 'printing') -----
  defaultNameStemForInstances
+ 	^ 'button' translatedNoop!
- 	^ 'button'!

Item was changed:
  ----- Method: ButtonProperties>>setTarget: (in category 'menu') -----
  setTarget: evt 
  	| rootMorphs |
+ 	rootMorphs := self world rootMorphsAt: evt targetPoint.
- 	rootMorphs := self world rootMorphsAt: evt hand targetOffset.
  	target := rootMorphs size > 1 
  		ifTrue: [rootMorphs second]
  		ifFalse: [nil]!

Item was added:
+ GenericPropertiesMorph subclass: #ButtonPropertiesMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Experimental'!
+ 
+ !ButtonPropertiesMorph commentStamp: '<historical>' prior: 0!
+ ButtonPropertiesMorph basicNew
+ 		targetMorph: self;
+ 		initialize;
+ 		openNearTarget!

Item was added:
+ ----- Method: ButtonPropertiesMorph>>acceptDroppingMorph:event:in: (in category 'as yet unclassified') -----
+ acceptDroppingMorph: aMorph event: evt in: aSubmorph
+ 
+ 	| why |
+ 
+ 	self clearDropHighlightingEvt: evt morph: aSubmorph.
+ 	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
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>addTextToTarget (in category 'as yet unclassified') -----
+ addTextToTarget
+ 
+ 	self targetProperties currentTextInButton ifNil: [
+ 		self targetProperties addTextToButton: '???'.
+ 	].
+ 	self targetProperties currentTextInButton openATextPropertySheet.
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>adjustTargetMouseDownHaloSize: (in category 'as yet unclassified') -----
+ adjustTargetMouseDownHaloSize: aFractionalPoint
+ 
+ 	self targetProperties mouseDownHaloWidth: ((aFractionalPoint x * 10) rounded max: 0).
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>adjustTargetMouseOverHaloSize: (in category 'as yet unclassified') -----
+ adjustTargetMouseOverHaloSize: aFractionalPoint
+ 
+ 	self targetProperties mouseOverHaloWidth: ((aFractionalPoint x * 10) rounded max: 0).
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>adjustTargetRepeatingInterval: (in category 'as yet unclassified') -----
+ adjustTargetRepeatingInterval: aFractionalPoint
+ 
+ 	| n |
+ 
+ 	n _ 2 raisedTo: ((aFractionalPoint x * 12) rounded max: 1).
+ 	self targetProperties delayBetweenFirings: n.
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>allowDropsInto:withIntent: (in category 'as yet unclassified') -----
+ allowDropsInto: aMorph withIntent: aSymbol
+ 
+ 	aMorph
+ 		on: #mouseEnterDragging send: #mouseEnterDraggingEvt:morph: to: self;
+ 		on: #mouseLeaveDragging send: #mouseLeaveDraggingEvt:morph: to: self;
+ 		on: #mouseLeave send: #clearDropHighlightingEvt:morph: to: self;
+ 		setProperty: #handlerForDrops toValue: self;
+ 		setProperty: #intentOfDroppedMorphs toValue: aSymbol;
+ 		borderWidth: 1;
+ 		borderColor: Color gray
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>attachMorphOfClass:to: (in category 'as yet unclassified') -----
+ attachMorphOfClass: aClass to: aHand
+ 
+ 	aHand attachMorph: aClass new!

Item was added:
+ ----- Method: ButtonPropertiesMorph>>clearDropHighlightingEvt:morph: (in category 'as yet unclassified') -----
+ clearDropHighlightingEvt: evt morph: aMorph
+ 
+ 	aMorph color: Color transparent.
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>defaultBorderColor (in category 'initialization') -----
+ defaultBorderColor
+ "answer the default border color/fill style for the receiver"
+ 	^ self defaultColor darker!

Item was added:
+ ----- Method: ButtonPropertiesMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ "answer the default color/fill style for the receiver"
+ 	^ Color
+ 		r: 0.935
+ 		g: 0.839
+ 		b: 0.452!

Item was added:
+ ----- Method: ButtonPropertiesMorph>>doEnables (in category 'as yet unclassified') -----
+ doEnables
+ 
+ 	| itsName |
+ 
+ 	self allMorphsDo: [ :each |
+ 		itsName _ each knownName.
+ 		itsName == #pickerForMouseDownColor ifTrue: [
+ 			self enable: each when: self targetWantsRollover
+ 		].
+ 		itsName == #pickerForMouseOverColor ifTrue: [
+ 			self enable: each when: self targetWantsRollover
+ 		].
+ 		itsName == #paneForRepeatingInterval ifTrue: [
+ 			self enable: each when: self targetRepeatingWhileDown
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>doRemoveProperties (in category 'as yet unclassified') -----
+ doRemoveProperties
+ 
+ 	myTarget buttonProperties: nil.
+ 	self delete.!

Item was added:
+ ----- Method: ButtonPropertiesMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	myTarget
+ 		ifNil: [myTarget _ RectangleMorph new openInWorld].
+ 
+ 	thingsToRevert at: #buttonProperties: put: myTarget buttonProperties.
+ 	self rebuild!

Item was added:
+ ----- Method: ButtonPropertiesMorph>>mouseDownEvent:for: (in category 'as yet unclassified') -----
+ mouseDownEvent: evt for: aSubmorph
+ 
+ 	| why aMenu |
+ 
+ 	why _ aSubmorph valueOfProperty: #intentOfDroppedMorphs.
+ 	why == #changeTargetMorph ifTrue: [
+ 		aMenu _ MenuMorph new
+ 			defaultTarget: self.
+ 		{
+ 			{'Rectangle'. RectangleMorph}.
+ 			{'Ellipse'. EllipseMorph}
+ 		} do: [ :pair |
+ 			aMenu	
+ 				add: pair first translated
+ 				target: self 
+ 				selector: #attachMorphOfClass:to: 
+ 				argumentList: {pair second. evt hand}.
+ 		].
+ 		aMenu popUpEvent: evt in: self world.
+ 		^self
+ 	].
+ 
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>mouseEnterDraggingEvt:morph: (in category 'as yet unclassified') -----
+ mouseEnterDraggingEvt: evt morph: aMorph
+ 
+ 	aMorph color: (Color red alpha: 0.5)!

Item was added:
+ ----- Method: ButtonPropertiesMorph>>mouseLeaveDraggingEvt:morph: (in category 'as yet unclassified') -----
+ mouseLeaveDraggingEvt: evt morph: aMorph
+ 
+ 	self clearDropHighlightingEvt: evt morph: aMorph.
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>paneForActsOnMouseDownToggle (in category 'as yet unclassified') -----
+ paneForActsOnMouseDownToggle
+ 
+ 	^self inARow: {
+ 		self
+ 			directToggleButtonFor: self 
+ 			getter: #targetActsOnMouseDown
+ 			setter: #toggleTargetActsOnMouseDown
+ 			help: 'If the button is to act when the mouse goes down' translated.
+ 		self lockedString: ' Mouse-down action' translated.
+ 	}
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>paneForActsOnMouseUpToggle (in category 'as yet unclassified') -----
+ paneForActsOnMouseUpToggle
+ 
+ 	^self inARow: {
+ 		self
+ 			directToggleButtonFor: self 
+ 			getter: #targetActsOnMouseUp
+ 			setter: #toggleTargetActsOnMouseUp
+ 			help: 'If the button is to act when the mouse goes up' translated.
+ 		self lockedString: ' Mouse-up action' translated.
+ 	}
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>paneForButtonSelectorReport (in category 'as yet unclassified') -----
+ paneForButtonSelectorReport
+ 
+ 	^self inARow: {
+ 		self lockedString: 'Action: ' translated.
+  		UpdatingStringMorph new
+ 			useStringFormat;
+ 			getSelector: #actionSelector;
+ 			target: self targetProperties;
+ 			growable: true;
+ 			minimumWidth: 24;
+ 			lock.
+ 	}
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>paneForButtonTargetReport (in category 'as yet unclassified') -----
+ paneForButtonTargetReport
+ 
+ 	| r |
+ 
+ 	r _ self inARow: {
+ 		self lockedString: 'Target: ' translated.
+  		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)' translated.
+ 	^self inARow: {r}
+ 
+ 
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>paneForChangeMouseDownLook (in category 'as yet unclassified') -----
+ paneForChangeMouseDownLook
+ 
+ 	| r |
+ 	r _ self inARow: {
+ 		self lockedString: ' Mouse-down look ' translated.
+ 	}.
+ 	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.' translated.
+ 	^r
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>paneForChangeMouseEnterLook (in category 'as yet unclassified') -----
+ paneForChangeMouseEnterLook
+ 
+ 	| r |
+ 	r _ self inARow: {
+ 		self lockedString: ' Mouse-enter look ' translated.
+ 	}.
+ 	self allowDropsInto: r withIntent: #changeTargetMouseEnterLook.
+ 	r setBalloonText: 'Drop another morph here to change the visual appearance of this button when the mouse enters it.' translated.
+ 	^r
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>paneForChangeVisibleMorph (in category 'as yet unclassified') -----
+ paneForChangeVisibleMorph
+ 
+ 	| r |
+ 	r _ self inARow: {
+ 		self lockedString: ' Change morph ' translated.
+ 	}.
+ 	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.' translated.
+ 	^r
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>paneForMouseDownColorPicker (in category 'as yet unclassified') -----
+ paneForMouseDownColorPicker
+ 
+ 	^self 
+ 		inAColumn: {
+ 			(self inAColumn: {
+ 				self colorPickerFor: self targetProperties
+ 						 getter: #mouseDownHaloColor setter: #mouseDownHaloColor:.
+ 				self lockedString: 'mouse-down halo color' translated.
+ 				self paneForMouseDownHaloWidth.
+ 			}
+ 			named: #pickerForMouseDownColor) layoutInset: 0.
+ 		}
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>paneForMouseDownHaloWidth (in category 'as yet unclassified') -----
+ paneForMouseDownHaloWidth
+ 
+ 	^(self inARow: {
+ 		self
+ 			buildFakeSlider: #valueForMouseDownHaloWidth 
+ 			selector: #adjustTargetMouseDownHaloSize:
+ 			help: 'Drag in here to change the halo width' translated
+ 	}) hResizing: #shrinkWrap
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>paneForMouseOverColorPicker (in category 'as yet unclassified') -----
+ paneForMouseOverColorPicker
+ 
+ 	^self 
+ 		inAColumn: {
+ 			(self inAColumn: {
+ 				self colorPickerFor: self targetProperties
+ 						 getter: #mouseOverHaloColor setter: #mouseOverHaloColor:.
+ 				self lockedString: 'mouse-over halo color' translated.
+ 				self paneForMouseOverHaloWidth.
+ 			}
+ 			named: #pickerForMouseOverColor) layoutInset: 0.
+ 		}
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>paneForMouseOverHaloWidth (in category 'as yet unclassified') -----
+ paneForMouseOverHaloWidth
+ 
+ 	^(self inARow: {
+ 		self
+ 			buildFakeSlider: #valueForMouseOverHaloWidth
+ 			selector: #adjustTargetMouseOverHaloSize:
+ 			help: 'Drag in here to change the halo width' translated
+ 	}) hResizing: #shrinkWrap
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>paneForRepeatingInterval (in category 'as yet unclassified') -----
+ paneForRepeatingInterval
+ 
+ 	^(self 
+ 		inAColumn: {
+ 			self
+ 				buildFakeSlider: #valueForRepeatingInterval
+ 				selector: #adjustTargetRepeatingInterval:
+ 				help: 'Drag in here to change how often the button repeats while the mouse is down' translated
+ 		}
+ 		 named: #paneForRepeatingInterval
+ 	) hResizing: #shrinkWrap
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>paneForWantsFiringWhileDownToggle (in category 'as yet unclassified') -----
+ paneForWantsFiringWhileDownToggle
+ 
+ 	^self inARow: {
+ 		self
+ 			directToggleButtonFor: self 
+ 			getter: #targetRepeatingWhileDown
+ 			setter: #toggleTargetRepeatingWhileDown
+ 			help: 'Turn repeating while mouse is held down on or off' translated.
+ 		self lockedString: ' Mouse-down repeating ' translated.
+ 	}
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>paneForWantsRolloverToggle (in category 'as yet unclassified') -----
+ paneForWantsRolloverToggle
+ 
+ 	^self inARow: {
+ 		self
+ 			directToggleButtonFor: self 
+ 			getter: #targetWantsRollover
+ 			setter: #toggleTargetWantsRollover
+ 			help: 'Turn mouse-over highlighting on or off' translated.
+ 		self lockedString: ' Mouse-over highlighting' translated.
+ 	}
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>rebuild (in category 'as yet unclassified') -----
+ rebuild
+ 
+ 	| buttonColor |
+ 
+ 	myTarget ensuredButtonProperties.
+ 	"self targetProperties unlockAnyText."	"makes styling the text easier"
+ 
+ 	self removeAllMorphs.
+ 	self addAColumn: {
+ 		self lockedString: ('Button Properties for {1}' translated format: {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' translated action: #addTextToTarget color: buttonColor
+ 					help: 'add some text to the button' translated.
+ 				self 
+ 					buttonNamed: 'Remove label' translated action: #removeTextFromTarget color: buttonColor
+ 					help: 'remove text from the button' translated.
+ 			}.
+ 			self addARow: {
+ 				self 
+ 					buttonNamed: 'Accept' translated action: #doAccept color: buttonColor
+ 					help: 'keep changes made and close panel' translated.
+ 				self 
+ 					buttonNamed: 'Cancel' translated action: #doCancel color: buttonColor
+ 					help: 'cancel changes made and close panel' translated.
+ 				self transparentSpacerOfSize: 10 at 3.
+ 				self 
+ 					buttonNamed: 'Main' translated action: #doMainProperties color: color lighter 
+ 					help: 'open a main properties panel for the morph' translated.
+ 				self 
+ 					buttonNamed: 'Remove' translated action: #doRemoveProperties color: color lighter 
+ 					help: 'remove the button properties of this morph' translated.
+ 			}.
+ 		}.
+ 		self inAColumn: {
+ 			self paneForChangeVisibleMorph
+ 		}.
+ 	}.
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>removeTextFromTarget (in category 'as yet unclassified') -----
+ removeTextFromTarget
+ 
+ 	self targetProperties addTextToButton: nil.
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>targetActsOnMouseDown (in category 'as yet unclassified') -----
+ targetActsOnMouseDown
+ 
+ 	^self targetProperties actWhen == #mouseDown!

Item was added:
+ ----- Method: ButtonPropertiesMorph>>targetActsOnMouseUp (in category 'as yet unclassified') -----
+ targetActsOnMouseUp
+ 
+ 	^self targetProperties actWhen == #mouseUp!

Item was added:
+ ----- Method: ButtonPropertiesMorph>>targetProperties (in category 'as yet unclassified') -----
+ targetProperties
+ 
+ 	^myTarget ensuredButtonProperties!

Item was added:
+ ----- Method: ButtonPropertiesMorph>>targetRepeatingWhileDown (in category 'as yet unclassified') -----
+ targetRepeatingWhileDown
+ 
+ 	^self targetProperties delayBetweenFirings notNil!

Item was added:
+ ----- Method: ButtonPropertiesMorph>>targetWantsRollover (in category 'as yet unclassified') -----
+ targetWantsRollover
+ 
+ 	^self targetProperties wantsRolloverIndicator!

Item was added:
+ ----- Method: ButtonPropertiesMorph>>toggleTargetActsOnMouseDown (in category 'as yet unclassified') -----
+ toggleTargetActsOnMouseDown
+ 
+ 	| prop |
+ 
+ 	prop _ self targetProperties.
+ 	prop actWhen: (prop actWhen == #mouseDown ifTrue: [nil] ifFalse: [#mouseDown])!

Item was added:
+ ----- Method: ButtonPropertiesMorph>>toggleTargetActsOnMouseUp (in category 'as yet unclassified') -----
+ toggleTargetActsOnMouseUp
+ 
+ 	| prop |
+ 
+ 	prop _ self targetProperties.
+ 	prop actWhen: (prop actWhen == #mouseUp ifTrue: [nil] ifFalse: [#mouseUp])!

Item was added:
+ ----- Method: ButtonPropertiesMorph>>toggleTargetRepeatingWhileDown (in category 'as yet unclassified') -----
+ toggleTargetRepeatingWhileDown
+ 
+ 	| prop |
+ 
+ 	prop _ self targetProperties.
+ 	prop delayBetweenFirings: (prop delayBetweenFirings ifNil: [1024] ifNotNil: [nil])
+ 	!

Item was added:
+ ----- Method: ButtonPropertiesMorph>>toggleTargetWantsRollover (in category 'as yet unclassified') -----
+ toggleTargetWantsRollover
+ 
+ 	self targetProperties wantsRolloverIndicator: self targetProperties wantsRolloverIndicator not!

Item was added:
+ ----- Method: ButtonPropertiesMorph>>valueForMouseDownHaloWidth (in category 'as yet unclassified') -----
+ valueForMouseDownHaloWidth
+ 
+ 	^ 'mouse-down halo width: ' translated, self targetProperties mouseDownHaloWidth printString
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>valueForMouseOverHaloWidth (in category 'as yet unclassified') -----
+ valueForMouseOverHaloWidth
+ 
+ 	^ 'mouse-over halo width: ' translated, self targetProperties mouseOverHaloWidth printString
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>valueForRepeatingInterval (in category 'as yet unclassified') -----
+ valueForRepeatingInterval
+ 
+ 	| n s |
+ 
+ 	n _ self targetProperties delayBetweenFirings.
+ 
+ 	s _ n ifNil: [
+ 		'*none*'
+ 	] ifNotNil: [
+ 		n < 1000 ifTrue: [n printString,' ms'] ifFalse: [(n // 1000) printString,' secs']
+ 	].
+ 	^'interval: ' translated, s
+ !

Item was added:
+ ----- Method: ButtonPropertiesMorph>>wantsDroppedMorph:event:in: (in category 'as yet unclassified') -----
+ wantsDroppedMorph: aMorph event: evt in: aSubmorph
+ 
+ 	| why |
+ 
+ 	why _ aSubmorph valueOfProperty: #intentOfDroppedMorphs.
+ 	^why notNil
+ 
+ " toValue: #changeTargetMorph.
+ 
+ 	^true"!

Item was added:
+ ----- Method: ByteArray>>bytesAnd: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ bytesAnd: aByteArray
+ 	
+ 	<primitive: 'primitiveAndByteArray' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveAndByteArray."
+ 
+ 	1 to: (self size min: aByteArray size) do: [:i |
+ 		self at: i put: (((self at: i) + (aByteArray at: i)) = 2 ifTrue: [1] ifFalse: [0]).
+ 	].
+ !

Item was added:
+ ----- Method: ByteArray>>bytesOr: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ bytesOr: aByteArray
+ 
+ 	<primitive: 'primitiveOrByteArray' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveOrByteArray."
+ 
+ 	1 to: (self size min: aByteArray size) do: [:i |
+ 		self at: i put: (((self at: i) + (aByteArray at: i)) > 0 ifTrue: [1] ifFalse: [0]).
+ 	].
+ !

Item was added:
+ ----- Method: ByteArray>>not (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ not
+ 
+ 	<primitive: 'primitiveNotByteArray' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveNotByteArray."
+ 
+ 	1 to: self size do: [:i |
+ 		self at: i put: ((self at: i) = 0 ifTrue: [1] ifFalse: [0]).
+ 	].
+ !

Item was added:
+ ----- Method: ByteString>>primitiveFindSubstring:in:startingAt:matchTable: (in category '*Etoys-Squeakland-comparing') -----
+ primitiveFindSubstring: key in: body startingAt: start matchTable: matchTable
+ 	"Answer the index in the string body at which the substring key first occurs, at or beyond start.  The match is determined using matchTable, which can be used to effect, eg, case-insensitive matches.  If no match is found, zero will be returned.
+ 
+ 	The algorithm below is not optimum -- it is intended to be translated to C which will go so fast that it wont matter."
+ 	| index |
+ 	<primitive: 'primitiveFindSubstring' module: 'MiscPrimitivePlugin'>
+ 	self var: #key declareC: 'unsigned char *key'.
+ 	self var: #body declareC: 'unsigned char *body'.
+ 	self var: #matchTable declareC: 'unsigned char *matchTable'.
+ 
+ 	key size = 0 ifTrue: [^ 0].
+ 	start to: body size - key size + 1 do:
+ 		[:startIndex |
+ 		index _ 1.
+ 			[(matchTable at: (body at: startIndex+index-1) asciiValue + 1)
+ 				= (matchTable at: (key at: index) asciiValue + 1)]
+ 				whileTrue:
+ 				[index = key size ifTrue: [^ startIndex].
+ 				index _ index+1]].
+ 	^ 0
+ "
+ ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 1 matchTable: CaseSensitiveOrder 1
+ ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 2 matchTable: CaseSensitiveOrder 7
+ ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 8 matchTable: CaseSensitiveOrder 0
+ ' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseSensitiveOrder 0
+ ' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseInsensitiveOrder 7
+ "!

Item was added:
+ ClipboardInterpreter subclass: #CP1253ClipboardInterpreter
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-TextConversion'!

Item was added:
+ ----- Method: CP1253ClipboardInterpreter>>fromSystemClipboard: (in category 'as yet unclassified') -----
+ fromSystemClipboard: aString
+ 
+ 	| result converter |
+ 	result := WriteStream on: (String new: aString size).
+ 	converter := CP1253TextConverter new.
+ 	aString do: [:each |
+ 		result nextPut: (converter toSqueak: each macToSqueak) asCharacter.
+ 	].
+ 	^ result contents.
+ !

Item was added:
+ ----- Method: CP1253ClipboardInterpreter>>toSystemClipboard: (in category 'as yet unclassified') -----
+ toSystemClipboard: aString
+ 
+ 	| result converter r |
+ 	aString isAsciiString ifTrue: [^ aString asOctetString]. "optimization"
+ 
+ 	result _ WriteStream on: (String new: aString size).
+ 	converter _ CP1253TextConverter new.
+ 	aString do: [:each |
+ 		r _ converter fromSqueak: each.
+ 		r charCode < 255 ifTrue: [
+ 		result nextPut: r squeakToMac]].
+ 	^ result contents.
+ !

Item was added:
+ KeyboardInputInterpreter subclass: #CP1253InputInterpreter
+ 	instanceVariableNames: 'converter'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-TextConversion'!

Item was added:
+ ----- Method: CP1253InputInterpreter>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 
+ 	converter _ CP1253TextConverter new.
+ !

Item was added:
+ ----- Method: CP1253InputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') -----
+ nextCharFrom: sensor firstEvt: evtBuf
+ 
+ 	| keyValue |
+ 	keyValue := evtBuf third.
+ 	^ converter toSqueak: keyValue asCharacter macToSqueak.
+ !

Item was added:
+ Morph subclass: #CachingMorph
+ 	instanceVariableNames: 'damageRecorder cacheCanvas'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Kernel'!
+ 
+ !CachingMorph commentStamp: '<historical>' prior: 0!
+ This morph can be used to cache the picture of a morph that takes a long time to draw. It should be used with judgement, however, since heavy use of caching can consume large amounts of memory.!

Item was added:
+ ----- Method: CachingMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color veryLightGray!

Item was added:
+ ----- Method: CachingMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 
+ 	submorphs isEmpty ifTrue: [^ super drawOn: aCanvas].
+ !

Item was added:
+ ----- Method: CachingMorph>>fullDrawOn: (in category 'drawing') -----
+ fullDrawOn: aCanvas
+ 	(aCanvas isVisible: self fullBounds) ifFalse:[^self].
+ 	self updateCacheCanvas: aCanvas.
+ 	aCanvas cache: self fullBounds
+ 			using: cacheCanvas form
+ 			during:[:cachingCanvas| super fullDrawOn: cachingCanvas].
+ !

Item was added:
+ ----- Method: CachingMorph>>imageForm (in category 'drawing') -----
+ imageForm
+ 
+ 	self updateCacheCanvas: Display getCanvas.
+ 	^ cacheCanvas form offset: self fullBounds topLeft
+ !

Item was added:
+ ----- Method: CachingMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	damageRecorder _ DamageRecorder new!

Item was added:
+ ----- Method: CachingMorph>>invalidRect:from: (in category 'change reporting') -----
+ invalidRect: damageRect from: aMorph
+ 	"Record the given rectangle in the damage list."
+ 	damageRecorder recordInvalidRect: (damageRect translateBy: self fullBounds origin negated).
+ 	super invalidRect: damageRect from: aMorph!

Item was added:
+ ----- Method: CachingMorph>>releaseCachedState (in category 'caching') -----
+ releaseCachedState
+ 
+ 	super releaseCachedState.
+ 	cacheCanvas _ nil.
+ !

Item was added:
+ ----- Method: CachingMorph>>updateCacheCanvas: (in category 'as yet unclassified') -----
+ updateCacheCanvas: aCanvas 
+ 	"Update the cached image of the morphs being held by this hand."
+ 
+ 	| myBnds rectList |
+ 	myBnds := self fullBounds.
+ 	(cacheCanvas isNil or: [cacheCanvas extent ~= myBnds extent]) 
+ 		ifTrue: 
+ 			[cacheCanvas := (aCanvas allocateForm: myBnds extent) getCanvas.
+ 			cacheCanvas translateBy: myBnds origin negated
+ 				during: [:tempCanvas | super fullDrawOn: tempCanvas].
+ 			^self].
+ 
+ 	"incrementally update the cache canvas"
+ 	rectList := damageRecorder 
+ 				invalidRectsFullBounds: (0 @ 0 extent: myBnds extent).
+ 	damageRecorder reset.
+ 	rectList do: 
+ 			[:r | 
+ 			cacheCanvas 
+ 				translateTo: myBnds origin negated
+ 				clippingTo: r
+ 				during: 
+ 					[:c | 
+ 					c fillColor: Color transparent.	"clear to transparent"
+ 					super fullDrawOn: c]]!

Item was added:
+ Morph subclass: #CalendarMorph
+ 	instanceVariableNames: 'date stepTime shouldUpdate'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Calendar'!
+ 
+ !CalendarMorph commentStamp: 'sw 1/25/2012 21:09' prior: 0!
+ CalendarMorph, by Ricardo Moran, 2011, with some changes by Scott Wallace, January 2012.
+ 
+ A CalendarMorph is single-month calendar that is scriptable using tiles in its viewer.  It always has a 'selected' date, for which the correct month and year are shown; the actual day corresponding to the selected date is highlighted on the calendar.
+ !

Item was added:
+ ----- Method: CalendarMorph class>>additionsToViewerCategories (in category 'viewer categories') -----
+ additionsToViewerCategories
+ 	"Answer definitions for viewer categories of a Calendar."
+ 
+ 	^ #(
+ 
+ 		(#'calendar' (
+ 			(slot date 'Shows the selected date' String readOnly Player getDate Player unused  )
+ 			(slot day 'Shows the selected day and lets you modify it' Number readWrite Player getDay Player setDay: )
+ 			(slot month 'Shows the selected month and lets you modify it' Number readWrite Player getMonth Player setMonth:  )
+ 			(slot year 'Shows the selected year and lets you modify it' Number readWrite Player getYear Player setYear:  )
+ 
+ 			(slot dayName 'Shows the name of the selected day' String readOnly Player getDayName Player unused  )
+ 			(slot monthName 'Shows the name of the selected month' String readOnly Player getMonthName Player unused  )
+ 			(slot dateFormat 'Lets you choose a format for displaying the date' DateFormat readWrite Player getDateFormat Player setDateFormat:  )
+ 
+ 			(command goToToday 'Show the current month and highlight the current day on it')
+ 			(slot julianDay 'The Julian day of the selected date' Number readWrite Player getJulianDay Player setJulianDay:)
+ )))!

Item was added:
+ ----- Method: CalendarMorph class>>assureDateFormatEstablished (in category 'class initialization') -----
+ assureDateFormatEstablished
+ 	"Make certain that there is a DateFormat vocabulary in the system's list."
+ 
+ 	Vocabulary addStandardVocabulary: (SymbolListType new vocabularyName: #DateFormat;
+ 				 symbols: #(#'dd/mm/yyyy' #'yyyy/mm/dd' #'mm/dd/yyyy')).!

Item was added:
+ ----- Method: CalendarMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	"Answer a description for use in parts bins"
+ 
+ 	^ self partName: 	'Calendar' translatedNoop
+ 		categories:		{'Just for Fun' translatedNoop}
+ 		documentation:	'A scriptable calendar' translatedNoop!

Item was added:
+ ----- Method: CalendarMorph class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"Class initialization."
+ 
+ 	self assureDateFormatEstablished!

Item was added:
+ ----- Method: CalendarMorph>>addDays: (in category 'actions') -----
+ addDays: aNumber
+ 	[self date: (date addDays: aNumber)]
+ 		on: Error
+ 		do: ["Nothing"]!

Item was added:
+ ----- Method: CalendarMorph>>addMonths: (in category 'actions') -----
+ addMonths: aNumber
+ 	[self date: (date addMonths: aNumber)]
+ 		on: Error
+ 		do: ["Nothing"]!

Item was added:
+ ----- Method: CalendarMorph>>buildMonthRow (in category 'building') -----
+ buildMonthRow
+ 	^ self newRow
+ 		addMorphBack: ((self newButtonWithContents: '<-') actionSelector: #previousMonth; target: self);
+ 		addMorphBack: AlignmentMorph newVariableTransparentSpacer;
+ 		addMorphBack: (date month name translated asMorph color: self labelsDefaultColor);
+ 		addMorphBack: AlignmentMorph newVariableTransparentSpacer;
+ 		addMorphBack: ((self newButtonWithContents: '->') actionSelector: #nextMonth; target: self)!

Item was added:
+ ----- Method: CalendarMorph>>buildYearRow (in category 'building') -----
+ buildYearRow
+ 	^ self newRow
+ 		addMorphBack: ((self newButtonWithContents: '<-') actionSelector: #previousYear; target: self);
+ 		addMorphBack: AlignmentMorph newVariableTransparentSpacer;
+ 		addMorphBack: (date year name asMorph color: self labelsDefaultColor);
+ 		addMorphBack: AlignmentMorph newVariableTransparentSpacer;
+ 		addMorphBack: ((self newButtonWithContents: '->') actionSelector: #nextYear; target: self)!

Item was added:
+ ----- Method: CalendarMorph>>color: (in category 'accessing') -----
+ color: aColor
+ 	super color: aColor.
+ 	shouldUpdate := true!

Item was added:
+ ----- Method: CalendarMorph>>date (in category 'accessing') -----
+ date
+ 	^ date!

Item was added:
+ ----- Method: CalendarMorph>>date: (in category 'accessing') -----
+ date: aDate
+ 	date := aDate.
+ 	shouldUpdate := true!

Item was added:
+ ----- Method: CalendarMorph>>dayInitialsRow (in category 'building') -----
+ dayInitialsRow
+ 	| newRow |
+ 	newRow := self newRow.
+ 	Week dayNames
+ 		do: [:dayName|
+ 			newRow addMorphBack: (TextMorph new 
+ 				contentsWrapped: dayName translated first asString;
+ 				textColor: self labelsDefaultColor;
+ 				autoFit: false;
+ 				width: 30;
+ 				centered;
+ 				lock)]
+ 		separatedBy: [newRow addMorphBack: AlignmentMorph newVariableTransparentSpacer].
+ 	^newRow !

Item was added:
+ ----- Method: CalendarMorph>>fillStyle: (in category 'accessing') -----
+ fillStyle: aFillStyle
+ 	super fillStyle: aFillStyle.
+ 	shouldUpdate := true!

Item was added:
+ ----- Method: CalendarMorph>>incrementStepTime (in category 'stepping') -----
+ incrementStepTime
+ 	stepTime := (stepTime + 1) min: self maximumStepTime!

Item was added:
+ ----- Method: CalendarMorph>>initialColor (in category 'initialize') -----
+ initialColor
+ 	"Answer the color to use for a new Calendar."
+ 
+ 	^  Color r: 0.516 g: 0.677 b: 1.0
+ 
+ "Note: Richo's initial implementation was to use a randomly-chosen color for each new Calendar, for which the code in this method would be:
+ 
+ 	^ Color random
+ 
+ ... but in this version, a standard, sedate color is used for each new calendar.   The user can of course change the color using the standard halo recolor tool"!

Item was added:
+ ----- Method: CalendarMorph>>initialize (in category 'initialize') -----
+ initialize
+ 	"One-time initialization of a new calendar."
+ 
+ 	super initialize.
+ 	date := Date today.
+ 	stepTime := self minimumStepTime.
+ 	shouldUpdate := false.
+ 	self layoutPolicy: TableLayout new;
+ 		listDirection: #topToBottom;
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #shrinkWrap;
+ 		color: self initialColor;
+ 		cornerStyle: #rounded;
+ 		initializeSubmorphs!

Item was added:
+ ----- Method: CalendarMorph>>initializeSubmorphs (in category 'initialize') -----
+ initializeSubmorphs
+ 	| weekRow dateButton |
+ 	self addMorphBack: self buildYearRow;
+ 		 addMorphBack: self buildMonthRow;
+ 		 addMorphBack: self dayInitialsRow.
+ 	date month weeks
+ 		do: [:week | 
+ 			weekRow := self newRow.
+ 			week dates
+ 				do: [:aDate | 
+ 					dateButton := self newDateButtonWithContents: aDate dayOfMonth asString.
+ 					dateButton actionSelector: #date:; 
+ 						 target: self;
+ 						 arguments: {aDate}.
+ 					date = aDate
+ 						ifTrue: [dateButton
+ 								color: (self color
+ 										mixed: 0.5
+ 										with: (self color adjustSaturation: 1 brightness: 1))].
+ 					date month ~= aDate month
+ 						ifTrue: [dateButton color: self color.
+ 							(dateButton findA: StringMorph)
+ 								color: Color gray].
+ 					weekRow addMorphBack: dateButton]
+ 				separatedBy: [weekRow addMorphBack: AlignmentMorph newVariableTransparentSpacer].
+ 			self addMorphBack: weekRow]!

Item was added:
+ ----- Method: CalendarMorph>>labelsDefaultColor (in category 'building') -----
+ labelsDefaultColor
+ 	^ self color makeForegroundColor !

Item was added:
+ ----- Method: CalendarMorph>>localeChanged (in category 'update') -----
+ localeChanged
+ 	self update!

Item was added:
+ ----- Method: CalendarMorph>>maximumStepTime (in category 'stepping') -----
+ maximumStepTime
+ 	^ 200!

Item was added:
+ ----- Method: CalendarMorph>>minimumStepTime (in category 'stepping') -----
+ minimumStepTime
+ 	^ 20!

Item was added:
+ ----- Method: CalendarMorph>>newButtonWithContents: (in category 'building') -----
+ newButtonWithContents: aByteString 
+ 	^SimpleButtonMorph new 
+ 		label: aByteString;
+ 		color: (self color mixed: 0.5 with: Color gray);
+ 		borderColor: #raised;
+ 		borderWidth: 2!

Item was added:
+ ----- Method: CalendarMorph>>newDateButtonWithContents: (in category 'building') -----
+ newDateButtonWithContents: aByteString 
+ 	^SimpleButtonMorph new
+ 		label: aByteString;
+ 		cornerStyle: #square;
+ 		color: self color muchLighter;
+ 		borderColor: #raised;
+ 		borderWidth: 2;
+ 		width: 30!

Item was added:
+ ----- Method: CalendarMorph>>newRow (in category 'building') -----
+ newRow
+ 	^ AlignmentMorph newRow
+ 		vResizing: #shrinkWrap;
+ 		color: Color transparent!

Item was added:
+ ----- Method: CalendarMorph>>nextMonth (in category 'actions') -----
+ nextMonth
+ 	self addMonths: 1!

Item was added:
+ ----- Method: CalendarMorph>>nextYear (in category 'actions') -----
+ nextYear
+ 	self addMonths: 12!

Item was added:
+ ----- Method: CalendarMorph>>previousMonth (in category 'actions') -----
+ previousMonth
+ 	self addMonths: -1!

Item was added:
+ ----- Method: CalendarMorph>>previousYear (in category 'actions') -----
+ previousYear
+ 	self addMonths: -12!

Item was added:
+ ----- Method: CalendarMorph>>step (in category 'stepping') -----
+ step
+ 	shouldUpdate
+ 		ifTrue: [self update.
+ 			stepTime := self minimumStepTime.
+ 			shouldUpdate := false]
+ 		ifFalse: [self incrementStepTime]!

Item was added:
+ ----- Method: CalendarMorph>>stepTime (in category 'stepping') -----
+ stepTime
+ 	^ stepTime !

Item was added:
+ ----- Method: CalendarMorph>>update (in category 'update') -----
+ update
+ 	self submorphsDo: [:m | m delete].
+ 	self initializeSubmorphs !

Item was added:
+ Object subclass: #CameraInterface
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-MorphicExtras-WebCam'!
+ 
+ !CameraInterface commentStamp: '<historical>' prior: 0!
+ CameraInterface: Simple cross-platform webcam access interface from MIT Scratch. Small changes made so that different cameras can be tested when more than one is connected. The "CameraPlugin" binary should soon be included in the VM. On Linux the plugin is designed to take advantage of libv4l2 (if found) to support a wide range of cameras.
+ 
+ Copyright (c) 2009 Massachusetts Institute of Technology
+ 
+ Permission is hereby granted, free of charge, to any person obtaining a copy
+ of this software and associated documentation files (the "Software"), to deal
+ in the Software without restriction, including without limitation the rights
+ to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+ copies of the Software, and to permit persons to whom the Software is
+ furnished to do so, subject to the following conditions:
+ 
+ The above copyright notice and this permission notice shall be included in
+ all copies or substantial portions of the Software.
+ 
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+ THE SOFTWARE.
+ !

Item was added:
+ ----- Method: CameraInterface class>>camera:getParam: (in category 'camera ops') -----
+ camera: cameraNum getParam: paramNum
+ 	"Answer the given parameter for the given camera."
+ 
+ 	<primitive: 'primGetParam' module: 'CameraPlugin'>
+ 	^ nil
+ !

Item was added:
+ ----- Method: CameraInterface class>>cameraIsAvailable (in category 'camera ops') -----
+ cameraIsAvailable
+ 	"Answer true if at least one camera is available."
+ 
+ 	^(self cameraName: 1) notNil
+ !

Item was added:
+ ----- Method: CameraInterface class>>cameraIsOpen: (in category 'camera ops') -----
+ cameraIsOpen: cameraNum
+ 	"Answer true if the camera is open."
+ 
+ 	^ (self packedFrameExtent: cameraNum) > 0
+ !

Item was added:
+ ----- Method: CameraInterface class>>cameraName: (in category 'camera ops') -----
+ cameraName: cameraNum
+ 	"Answer the name of the given camera. Answer nil if there is no camera with the given number."
+ 
+ 	<primitive: 'primCameraName' module: 'CameraPlugin'>
+ 	^ nil
+ !

Item was added:
+ ----- Method: CameraInterface class>>closeCamera: (in category 'camera ops') -----
+ closeCamera: cameraNum
+ 	"Close the camera. Do nothing if it was not open."
+ 
+ 	<primitive: 'primCloseCamera' module: 'CameraPlugin'>
+ !

Item was added:
+ ----- Method: CameraInterface class>>declareCVarsIn: (in category 'translation') -----
+ declareCVarsIn: aCCodeGenerator
+ 	"self translate"
+ 
+ 	super declareCVarsIn: aCCodeGenerator.
+ 	aCCodeGenerator cExtras: '
+ #include "cameraOps.h"
+ #include <string.h>
+ '.!

Item was added:
+ ----- Method: CameraInterface class>>frameExtent: (in category 'camera ops') -----
+ frameExtent: cameraNum
+ 	"Answer the frame extent of the currently open camera, or zero if the camera isn't open."
+ 
+ 	| packedExtent |
+ 	packedExtent := self packedFrameExtent: cameraNum.
+ 	^ (packedExtent bitShift: -16) @ (packedExtent bitAnd: 16rFFFF) !

Item was added:
+ ----- Method: CameraInterface class>>getFrameForCamera:into: (in category 'camera ops') -----
+ getFrameForCamera: cameraNum into: aBitmap
+ 	"Copy a camera frame into the given Bitmap. The Bitmap should be a Form of depth 32 that is the same width and height as the current camera frame. Fail if the camera is not open or if the bitmap is not the right size. If successful, answer the number of frames received from the camera since the last call. If this is zero, then there has been no change."
+ 
+ 	<primitive: 'primGetFrame' module: 'CameraPlugin'>
+ 	^ 0!

Item was added:
+ ----- Method: CameraInterface class>>openCamera:width:height: (in category 'camera ops') -----
+ openCamera: cameraNum width: frameWidth height: frameHeight
+ 	"Open the given camera requesting the given frame dimensions. The camera number is usually 1 since you typically have only one camera plugged in. If the camera does not support the exact frame dimensions, an available frame size with width >= the requested width is selected."
+ 
+ 	<primitive: 'primOpenCamera' module: 'CameraPlugin'>
+ 	^ nil
+ !

Item was added:
+ ----- Method: CameraInterface class>>packedFrameExtent: (in category 'camera ops') -----
+ packedFrameExtent: cameraNum
+ 	"Answer the extent of the currently open camera packed in an integer. The top 16 bits are the width, the low 16 bits are the height. Answer zero if the camera isn't open."
+ 
+ 	<primitive: 'primFrameExtent' module: 'CameraPlugin'>
+ 	^ 0
+ !

Item was added:
+ ----- Method: CameraInterface class>>videoTest: (in category 'test') -----
+ videoTest: camNum
+ 	"A quick test of video input. Displays video on the screen until the mouse is pressed."
+ 	"self videoTest: 1"
+ 	"self videoTest: 2"
+ 
+ 	| f n startTime frameCount msecs fps |
+ 	(CameraInterface openCamera: camNum width: 320 height: 240) ifNil: [^ self inform: 'no camera'].
+ 	self waitForCameraStart: camNum.
+ 	(self frameExtent: camNum) x = 0 ifTrue: [^ self inform: 'no camera'].
+ 	f := Form extent: (CameraInterface frameExtent: camNum) depth: 32.
+ 	frameCount := 0.
+ 	startTime := nil.
+ 	[Sensor anyButtonPressed] whileFalse: [
+ 		n := CameraInterface getFrameForCamera: camNum into: f bits.
+ 		n > 0 ifTrue: [
+ 			startTime ifNil: [startTime := Time millisecondClockValue].
+ 			frameCount := frameCount + 1.
+ 			f display]].
+ 	Sensor waitNoButton.
+ 	msecs := Time millisecondClockValue - startTime.
+ 	CameraInterface closeCamera: camNum.
+ 	fps := (frameCount * 1000) // msecs.
+ 	^ frameCount printString, ' frames at ', fps printString, ' frames/sec'!

Item was added:
+ ----- Method: CameraInterface class>>waitForCameraStart: (in category 'camera ops') -----
+ waitForCameraStart: camNum
+ 	"Wait for the camera to get it's first frame (indicated by a non-zero frame extent. Timeout after a few seconds."
+ 	"self waitForCameraStart"
+ 
+ 	| startTime |
+ 	startTime := Time millisecondClockValue.
+ 	[(Time millisecondClockValue - startTime) < 2000] whileTrue: [
+ 		(self packedFrameExtent: camNum) > 0 ifTrue: [^ self].
+ 		(Delay forMilliseconds: 50) wait].!

Item was added:
+ ----- Method: CascadeNode>>defaultBlockType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultBlockType: t1 
+ 	^ #default!

Item was added:
+ ----- Method: CascadeNode>>defaultMessageType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultMessageType
+ 	^ #none!

Item was added:
+ ----- Method: CascadeNode>>emitForValue:on: (in category '*Etoys-Squeakland-code generation') -----
+ emitForValue: stack on: aStream
+ 
+ 	receiver emitForValue: stack on: aStream.
+ 	1 to: messages size - 1 do: 
+ 		[:i | 
+ 		aStream nextPut: Dup.
+ 		stack push: 1.
+ 		(messages at: i) emitForValue: stack on: aStream.
+ 		aStream nextPut: Pop.
+ 		stack pop: 1].
+ 	messages last emitForValue: stack on: aStream!

Item was added:
+ ----- Method: CascadeNode>>firstInReceivers: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ firstInReceivers: t1 
+ 	^ t1 first!

Item was added:
+ ----- Method: CascadeNode>>getAllChildren (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getAllChildren
+ 
+ 	^ (Array with: receiver), messages.
+ !

Item was added:
+ ----- Method: CascadeNode>>getElderSiblingOf: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getElderSiblingOf: node
+ 
+ 	| index |
+ 	((index _ messages indexOf: node) > 1) ifTrue: [^ messages at: index - 1].
+ 	index = 1 ifTrue: [^ receiver].
+ 	^ nil.
+ !

Item was added:
+ ----- Method: CascadeNode>>getFirstChild (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getFirstChild
+ 
+ 	^ receiver.
+ !

Item was added:
+ ----- Method: CascadeNode>>getLastChild (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getLastChild
+ 
+ 	messages size > 0 ifTrue: [^ messages last].
+ 	^ receiver.
+ !

Item was added:
+ ----- Method: CascadeNode>>isFirstChild: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isFirstChild: childNode
+ 
+ 	^ childNode = receiver.
+ !

Item was added:
+ ----- Method: CascadeNode>>isLastChild: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isLastChild: childNode
+ 
+ 	messages size > 0 ifTrue: [^ childNode = messages last].
+ 	^ childNode = receiver.
+ !

Item was added:
+ ----- Method: CascadeNode>>isStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isStmt: t1 
+ 	^ t1 = #top
+ 		or: [t1 = #condition]!

Item was added:
+ ----- Method: CascadeNode>>isTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTest: t1 parentNode: t2 
+ 	t1 = true
+ 		ifTrue: [^ true].
+ 	^ (t2 isMemberOf: MessageNode)
+ 		and: [t2 receiver = self
+ 				and: [t2 messageType value = #condition]]!

Item was added:
+ ----- Method: CascadeNode>>isTopStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmt: t1 
+ 	t1 = nil
+ 		ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: CascadeNode>>rcvr: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr: t1 
+ 	^ t1!

Item was added:
+ ----- Method: CascadeNode>>replaceNode:with: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ replaceNode: childNode with: newNode
+ 
+ 	| index |
+ 	childNode = receiver ifTrue: [receiver _ newNode. ^ self].
+ 	(index _ messages indexOf: childNode) > 0
+ 		ifTrue: [messages at: index put: newNode. ^ self].
+ !

Item was added:
+ ----- Method: CascadeNode>>sizeForValue: (in category '*Etoys-Squeakland-code generation') -----
+ sizeForValue: encoder
+ 
+ 	| size |
+ 	size _ (receiver sizeForValue: encoder) + (messages size - 1 * 2).
+ 	messages do: [:aMessage | size _ size + (aMessage sizeForValue: encoder)].
+ 	^size!

Item was added:
+ ----- Method: CascadeNode>>thisNode (in category '*Etoys-Tweak-Kedama-Generated') -----
+ thisNode
+ 	^ self!

Item was added:
+ ----- Method: CascadeNode>>transfer: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 
+ 	^ t1!

Item was added:
+ ----- Method: CascadeNode>>visitBy: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ visitBy: visitor
+ 
+ 	visitor visit: self.
+ 	receiver visitBy: visitor.
+ 	messages do: [:a | a visitBy: visitor].
+ !

Item was added:
+ ----- Method: CategoryViewer>>addColorSeesDetailTo: (in category '*Etoys-Squeakland-entries') -----
+ addColorSeesDetailTo: aRow
+ 	"Special-casee code for the boolean-valued phrase variously known as is-over-color or sees-color."
+ 	| hotTileForSelf colorMorph |
+ 	(aRow submorphs last) delete.
+ 	aRow addMorphBack: (hotTileForSelf _ ColorSeerTile new showPalette: false; yourself).
+ 	aRow addMorphBack: (colorMorph _ ColorTileMorph new showPalette: false;
+ 				typeColor: (ScriptingSystem colorForType: #Color); yourself).
+ 	colorMorph colorSwatch color: Color blue.
+ 	 hotTileForSelf on: #mouseEnter send: #addGetterFeedback to: aRow.
+ 	hotTileForSelf on: #mouseLeave send: #removeHighlightFeedback to: aRow.
+ 	hotTileForSelf on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow.
+ 
+ 	hotTileForSelf  on: #mouseDown send: #makeGetter:event:from:
+ 		to: self
+ 		withValue: (Array with: #color:sees: with: #Boolean).
+ 
+ 	 colorMorph on: #mouseEnter send: #addGetterFeedback to: aRow.
+ 	colorMorph on: #mouseLeave send: #removeHighlightFeedback to: aRow.
+ 	colorMorph on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow.
+ 
+ 	colorMorph  on: #mouseDown send: #makeGetter:event:from:
+ 		to: self
+ 		withValue: (Array with: #color:sees: with: #Boolean).
+ 
+ 	aRow addMorphBack: (Morph new extent: 0@(aRow height)).
+ !

Item was changed:
  ----- Method: CategoryViewer>>addHeaderMorph (in category 'header pane') -----
  addHeaderMorph
  	"Add the header at the top of the viewer, with a control for choosing the category, etc."
  
  	| header aButton |
+ 	header _ AlignmentMorph newRow color: self color; wrapCentering: #center; cellPositioning: #leftCenter.
- 	header := AlignmentMorph newRow color: self color; wrapCentering: #center; cellPositioning: #leftCenter.
- 	aButton := self tanOButton.
- 	header addMorph: aButton.
- 	aButton actionSelector: #delete;
- 		setBalloonText: 'remove this pane from the screen
- don''t worry -- nothing will be lost!!.' translated.
- 	self maybeAddArrowsTo: header.
  	header beSticky.
+ 	header layoutInset: 0.
+ 	header cellInset: 0.
+ 	aButton _ self tanOButton.
+ 	header addMorph: aButton.
+ 	aButton setBalloonText: 'remove this pane from the screen
+ don''t worry -- nothing will be lost!!' translated.
+ 	header addMorphBack: self spacerAfterButton.
  	self addMorph: header.
  	self addNamePaneTo: header.
+ 	chosenCategorySymbol _ #basic!
- 	chosenCategorySymbol := #basic!

Item was changed:
  ----- Method: CategoryViewer>>addIsOverColorDetailTo: (in category 'entries') -----
  addIsOverColorDetailTo: aRow
  	"Special-casee code for the boolean-valued phrase variously known as is-over-color or sees-color."
  
+ 	| hotTileForSelf |
+ 	aRow addMorphBack: (Morph new color: self color; extent: 0 at 10).  "spacer"
+ 	hotTileForSelf _ ColorTileMorph new showPalette: false;
+ 				typeColor: (ScriptingSystem colorForType: #Color); yourself.
+ 	hotTileForSelf colorSwatch color: Color blue.
+ 	 hotTileForSelf on: #mouseEnter send: #addGetterFeedback to: aRow.
+ 	hotTileForSelf on: #mouseLeave send: #removeHighlightFeedback to: aRow.
+ 	hotTileForSelf on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow.
+ 	hotTileForSelf  on: #mouseDown send: #makeGetter:event:from:
+ 		to: self
+ 		withValue: (Array with: #seesColor: with: #Color).
+         aRow addMorphBack: hotTileForSelf.
- 	| clrTile |
- 	aRow addMorphBack: (Morph new color: self color; extent: 2 at 10).  "spacer"
- 	aRow addMorphBack: (clrTile := Color blue newTileMorphRepresentative).
  
+ 
+ 
  "The following commented-out code put a readout up; the readout was very nice, but was very consumptive of cpu time, which is why the is-over-color tile got removed from the viewer long ago.  Now is-over-color is reinstated to the viewer, minus the expensive readout..."
  
  "	aRow addMorphBack: (AlignmentMorph new beTransparent).
+ 	readout _ UpdatingStringMorphWithArgument new
- 	readout := UpdatingStringMorphWithArgument new
  			target: scriptedPlayer; getSelector: #seesColor:; growable: false; putSelector: nil;
  			argumentTarget: clrTile colorSwatch argumentGetSelector: #color.
  	readout useDefaultFormat.
+ 	aTile _ StringReadoutTile new typeColor: Color lightGray lighter.
- 	aTile := StringReadoutTile new typeColor: Color lightGray lighter.
  	aTile addMorphBack: readout.
  	aRow addMorphBack: aTile.
  	aTile setLiteralTo: (scriptedPlayer seesColor: clrTile colorSwatch color) printString width: 30"!

Item was changed:
  ----- Method: CategoryViewer>>addNamePaneTo: (in category 'header pane') -----
  addNamePaneTo: header 
+ 	"Add the namePane, which is a pop-up"
+ 
+ 	| triangle aLabel |
+ 	namePane := BorderedMorph new.
+ 	namePane layoutPolicy: TableLayout new.
+ 	namePane hResizing: #spaceFill.
+ 	namePane listDirection: #leftToRight.
+ 	namePane wrapCentering: #center.
+ 	namePane cellInset: 2.
+ 	namePane layoutInset: 6 @ 0.
+ 
+ 	namePane color: ScriptingSystem baseColor.
+ 	namePane borderColor: Preferences menuTitleBorderColor.
- 	"Add the namePane, which may be a popup or a type-in 
- 	depending on the type of CategoryViewer"
- 	| aButton |
- 	namePane := RectangleMorph newSticky color: Color brown veryMuchLighter.
  	namePane borderWidth: 0.
+ 
+ 	namePane height: TileMorph defaultH.
+ 	namePane useRoundedCornersInEtoys.
+ 
+ 	triangle _ ImageMorph new image: (ScriptingSystem formAtKey: #MenuTriangle).
+ 	namePane addMorph: triangle.
+ 	aLabel := StringMorph contents: '---------' font: ScriptingSystem fontForViewerCategoryPopups.
+ 
+ 	namePane addMorphBack: aLabel.
+ 	namePane on: #mouseDown send: #chooseCategory to: self.
+ 	header addMorphBack: namePane!
- 	aButton := (StringButtonMorph
- 				contents: '-----'
- 				font: Preferences standardButtonFont)
- 				color: Color black.
- 	aButton target: self;
- 		 arguments: Array new;
- 		 actionSelector: #chooseCategory.
- 	aButton actWhen: #buttonDown.
- 	namePane addMorph: aButton.
- 	aButton position: namePane position.
- 	namePane align: namePane topLeft with: bounds topLeft + (50 @ 0).
- 	namePane setBalloonText: 'category (click here to choose a different one)' translated.
- 	header addMorphBack: namePane.
- 	(namePane isKindOf: RectangleMorph)
- 		ifTrue: [namePane addDropShadow.
- 			namePane shadowColor: Color gray]
- !

Item was added:
+ ----- Method: CategoryViewer>>addPlayerArgumentTo: (in category '*Etoys-Squeakland-entries') -----
+ addPlayerArgumentTo: aRow
+ 	"Add, delimited by spacer morphs, a player-valued TileMorph to the row provided."
+ 
+ 	| aTileToRefer |
+ 	aRow addMorphBack: (Morph new extent: 0 at 0).  "spacer (Is this spacer really needed??? - takashi)"
+ 	aTileToRefer :=  self presenter standardPlayer tileToRefer.
+ 	aTileToRefer on: #mouseEnter send: #addGetterFeedback to: aRow.
+ 		aTileToRefer on: #mouseLeave send: #removeHighlightFeedback to: aRow.
+ 		aTileToRefer on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow.
+ 	aRow addMorphBack: aTileToRefer .
+ 	aRow addMorphBack: (AlignmentMorph new beTransparent).  "flexible spacer"
+ 
+ !

Item was changed:
  ----- Method: CategoryViewer>>adjustColorsAndBordersWithin (in category 'categories') -----
  adjustColorsAndBordersWithin
  	"Adjust the colors and borders of submorphs to suit current fashion"
  
  	self allMorphsDo: [:aMorph | 
- 		(aMorph isKindOf: ViewerLine) ifTrue:
- 			[aMorph layoutInset: 1].
  		(aMorph isKindOf: TilePadMorph) ifTrue:
  			[aMorph beTransparent].
  		(aMorph isKindOf: PhraseTileMorph) ifTrue:
  			[aMorph beTransparent.
  			aMorph borderWidth: 0].
  
  		(aMorph isKindOf: TileMorph)
  			ifTrue:
  				[aMorph borderWidth: 1]].
+ !
- 
- 	self borderWidth: 1!

Item was changed:
  ----- Method: CategoryViewer>>arrowSetterButton:args: (in category 'get/set slots') -----
  arrowSetterButton: sel args: argArray
  
  	| m |
+ 	m _ RectangleMorph new
- 	m := RectangleMorph new
  		color: (ScriptingSystem colorForType: #command);
+ 		extent: (ScriptingSystem formAtKey: #Gets) extent;
- 		extent: 24 at TileMorph defaultH;
  		borderWidth: 0.
+ 	m addMorphCentered: (ImageMorph new image: (ScriptingSystem formAtKey: #Gets)).
- 	m addMorphCentered: (ImageMorph new image: (ScriptingSystem formAtKey: 'Gets')).
  	m setBalloonText: 'drag from here to obtain an assignment phrase.' translated.
  	m on: #mouseDown send: sel
  		to: self
  		withValue: argArray.
  	^ m
  !

Item was added:
+ ----- Method: CategoryViewer>>assureCategoryFullyVisible (in category '*Etoys-Squeakland-categories') -----
+ assureCategoryFullyVisible
+ 	"Keep deleting categoryviewers other than the receiver  until the receiver is fully visible."
+ 
+ 	| ready toDelete |
+ 	ready := false.
+ 	[(self  bounds bottom > ActiveWorld bottom) and: [ready not]] whileTrue:
+ 			[owner submorphs size > 2 ifTrue:
+ 				[toDelete :=owner submorphs allButFirst reversed detect: [:cv | cv ~~ self] ifNone: [^ self].
+ 				toDelete delete.
+ 				ActiveWorld doOneCycleNow]
+ 			ifFalse:
+ 				[ready := true]]!

Item was changed:
  ----- Method: CategoryViewer>>booleanPhraseForBounceOnOfType:retrieverOp:player: (in category 'support') -----
  booleanPhraseForBounceOnOfType: retrieverType retrieverOp: retrieverOp player: aPlayer
  	"Answer a boolean-valued phrase derived from a retriever (e.g. 'car's heading'); this is in order to assure that tiles laid down in a TEST area will indeed produce a boolean result"
  
  	| outerPhrase getterPhrase receiverTile  rel finalTile |
+ 	rel _ (Vocabulary vocabularyForType:  retrieverType) comparatorForSampleBoolean.
+ 	outerPhrase _ PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: retrieverType argType: retrieverType.
+ 	getterPhrase _  PhraseTileMorph new setBounceOnOperator: retrieverOp type: retrieverType rcvrType: #Player argType: nil.
- 	rel := (Vocabulary vocabularyForType:  retrieverType) comparatorForSampleBoolean.
- 	outerPhrase := PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: retrieverType argType: retrieverType.
- 	getterPhrase :=  PhraseTileMorph new setBounceOnOperator: retrieverOp type: retrieverType rcvrType: #Player argType: nil.
- 	getterPhrase submorphs third delete.
  	getterPhrase submorphs second setSlotRefOperator: retrieverOp.
- 	"getterPhrase submorphs second setPatchDefaultTo: (scriptedPlayer defaultPatchPlayer)."
  	getterPhrase submorphs first changeTableLayout.
+ 	receiverTile _ aPlayer tileToRefer bePossessive.
- 	receiverTile := aPlayer tileToRefer bePossessive.
  	"self halt."
  	receiverTile position: getterPhrase firstSubmorph position.
  	getterPhrase firstSubmorph addMorph: receiverTile.
  
  	outerPhrase firstSubmorph addMorph: getterPhrase.
+ 	finalTile _ ScriptingSystem tileForArgType: retrieverType.	"comes with arrows"
- 	finalTile := ScriptingSystem tileForArgType: retrieverType.	"comes with arrows"
  	outerPhrase submorphs last addMorph: finalTile.
  	outerPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: rel).    
  	^ outerPhrase!

Item was changed:
  ----- Method: CategoryViewer>>booleanPhraseForGetAngleToOfType:retrieverOp:player: (in category 'support') -----
  booleanPhraseForGetAngleToOfType: retrieverType retrieverOp: retrieverOp player: aPlayer
  	"Answer a boolean-valued phrase derived from a retriever (e.g. 'car's heading'); this is in order to assure that tiles laid down in a TEST area will indeed produce a boolean result"
  
  	| outerPhrase getterPhrase receiverTile  rel finalTile |
+ 	rel _ (Vocabulary vocabularyForType:  retrieverType) comparatorForSampleBoolean.
+ 	outerPhrase _ PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: retrieverType argType: retrieverType.
+ 	getterPhrase _  PhraseTileMorph new setAngleToOperator: retrieverOp type: retrieverType rcvrType: #Player argType: nil.
- 	rel := (Vocabulary vocabularyForType:  retrieverType) comparatorForSampleBoolean.
- 	outerPhrase := PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: retrieverType argType: retrieverType.
- 	getterPhrase :=  PhraseTileMorph new setAngleToOperator: retrieverOp type: retrieverType rcvrType: #Player argType: nil.
- 	getterPhrase submorphs third delete.
  	getterPhrase submorphs second setSlotRefOperator: retrieverOp.
+ 	getterPhrase submorphs second setArgumentDefaultTo: scriptedPlayer.
- 	getterPhrase submorphs second setTurtleDefaultTo: scriptedPlayer.
  	getterPhrase submorphs first changeTableLayout.
+ 	receiverTile _ aPlayer tileToRefer bePossessive.
- 	receiverTile := aPlayer tileToRefer bePossessive.
  	receiverTile position: getterPhrase firstSubmorph position.
  	getterPhrase firstSubmorph addMorph: receiverTile.
  
  	outerPhrase firstSubmorph addMorph: getterPhrase.
+ 	finalTile _ ScriptingSystem tileForArgType: retrieverType.	"comes with arrows"
- 	finalTile := ScriptingSystem tileForArgType: retrieverType.	"comes with arrows"
  	outerPhrase submorphs last addMorph: finalTile.
  	outerPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: rel).    
  	^ outerPhrase!

Item was changed:
  ----- Method: CategoryViewer>>booleanPhraseForGetColorComponentOfType:componentName:retrieverOp:player: (in category 'support') -----
  booleanPhraseForGetColorComponentOfType: retrieverType componentName: componentName retrieverOp: retrieverOp player: aPlayer
  	"Answer a boolean-valued phrase derived from a retriever (e.g. 'car's heading'); this is in order to assure that tiles laid down in a TEST area will indeed produce a boolean result"
  
  	| outerPhrase getterPhrase receiverTile  rel finalTile |
+ 	rel _ (Vocabulary vocabularyForType:  retrieverType) comparatorForSampleBoolean.
+ 	outerPhrase _ PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: retrieverType argType: retrieverType.
+ 	getterPhrase _  PhraseTileMorph new setGetColorComponentOperator: retrieverOp componentName: componentName type: retrieverType rcvrType: #Player argType: nil.
- 	rel := (Vocabulary vocabularyForType:  retrieverType) comparatorForSampleBoolean.
- 	outerPhrase := PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: retrieverType argType: retrieverType.
- 	getterPhrase :=  PhraseTileMorph new setGetColorComponentOperator: retrieverOp componentName: componentName type: retrieverType rcvrType: #Player argType: nil.
- 	getterPhrase submorphs third delete.
  	getterPhrase submorphs second setSlotRefOperator: retrieverOp.
  	getterPhrase submorphs second setPatchDefaultTo: (scriptedPlayer defaultPatchPlayer).
  	getterPhrase submorphs first changeTableLayout.
+ 	receiverTile _ aPlayer tileToRefer bePossessive.
- 	receiverTile := aPlayer tileToRefer bePossessive.
  	"self halt."
  	receiverTile position: getterPhrase firstSubmorph position.
  	getterPhrase firstSubmorph addMorph: receiverTile.
  
  	outerPhrase firstSubmorph addMorph: getterPhrase.
+ 	finalTile _ ScriptingSystem tileForArgType: retrieverType.	"comes with arrows"
- 	finalTile := ScriptingSystem tileForArgType: retrieverType.	"comes with arrows"
  	outerPhrase submorphs last addMorph: finalTile.
  	outerPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: rel).    
  	^ outerPhrase!

Item was changed:
  ----- Method: CategoryViewer>>booleanPhraseForGetDistanceToOfType:retrieverOp:player: (in category 'support') -----
  booleanPhraseForGetDistanceToOfType: retrieverType retrieverOp: retrieverOp player: aPlayer
  	"Answer a boolean-valued phrase derived from a retriever (e.g. 'car's heading'); this is in order to assure that tiles laid down in a TEST area will indeed produce a boolean result"
  
  	| outerPhrase getterPhrase receiverTile  rel finalTile |
+ 	rel _ (Vocabulary vocabularyForType:  retrieverType) comparatorForSampleBoolean.
+ 	outerPhrase _ PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: retrieverType argType: retrieverType.
+ 	getterPhrase _  PhraseTileMorph new setDistanceToOperator: retrieverOp type: retrieverType rcvrType: #Player argType: nil.
- 	rel := (Vocabulary vocabularyForType:  retrieverType) comparatorForSampleBoolean.
- 	outerPhrase := PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: retrieverType argType: retrieverType.
- 	getterPhrase :=  PhraseTileMorph new setDistanceToOperator: retrieverOp type: retrieverType rcvrType: #Player argType: nil.
- 	getterPhrase submorphs third delete.
  	getterPhrase submorphs second setSlotRefOperator: retrieverOp.
+ 	getterPhrase submorphs second setArgumentDefaultTo: scriptedPlayer.
- 	getterPhrase submorphs second setTurtleDefaultTo: scriptedPlayer.
  	getterPhrase submorphs first changeTableLayout.
+ 	receiverTile _ aPlayer tileToRefer bePossessive.
- 	receiverTile := aPlayer tileToRefer bePossessive.
  	"self halt."
  	receiverTile position: getterPhrase firstSubmorph position.
  	getterPhrase firstSubmorph addMorph: receiverTile.
  
  	outerPhrase firstSubmorph addMorph: getterPhrase.
+ 	finalTile _ ScriptingSystem tileForArgType: retrieverType.	"comes with arrows"
- 	finalTile := ScriptingSystem tileForArgType: retrieverType.	"comes with arrows"
  	outerPhrase submorphs last addMorph: finalTile.
  	outerPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: rel).    
  	^ outerPhrase!

Item was changed:
  ----- Method: CategoryViewer>>booleanPhraseForGetPatchValueOfType:retrieverOp:player: (in category 'support') -----
  booleanPhraseForGetPatchValueOfType: retrieverType retrieverOp: retrieverOp player: aPlayer
  	"Answer a boolean-valued phrase derived from a retriever (e.g. 'car's heading'); this is in order to assure that tiles laid down in a TEST area will indeed produce a boolean result"
  
  	| outerPhrase getterPhrase receiverTile  rel finalTile |
+ 	rel _ (Vocabulary vocabularyForType:  retrieverType) comparatorForSampleBoolean.
+ 	outerPhrase _ PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: retrieverType argType: retrieverType.
+ 	getterPhrase _  PhraseTileMorph new setGetPixelOperator: retrieverOp type: retrieverType rcvrType: #Player argType: nil.
- 	rel := (Vocabulary vocabularyForType:  retrieverType) comparatorForSampleBoolean.
- 	outerPhrase := PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: retrieverType argType: retrieverType.
- 	getterPhrase :=  PhraseTileMorph new setGetPixelOperator: retrieverOp type: retrieverType rcvrType: #Player argType: nil.
- 	getterPhrase submorphs third delete.
  	getterPhrase submorphs second setSlotRefOperator: retrieverOp.
+ 	getterPhrase submorphs second setArgumentDefaultTo: (scriptedPlayer defaultPatchPlayer).
- 	getterPhrase submorphs second setPatchDefaultTo: (scriptedPlayer defaultPatchPlayer).
  	getterPhrase submorphs first changeTableLayout.
+ 	receiverTile _ aPlayer tileToRefer bePossessive.
- 	receiverTile := aPlayer tileToRefer bePossessive.
  	"self halt."
  	receiverTile position: getterPhrase firstSubmorph position.
  	getterPhrase firstSubmorph addMorph: receiverTile.
  
  	outerPhrase firstSubmorph addMorph: getterPhrase.
+ 	finalTile _ ScriptingSystem tileForArgType: retrieverType.	"comes with arrows"
- 	finalTile := ScriptingSystem tileForArgType: retrieverType.	"comes with arrows"
  	outerPhrase submorphs last addMorph: finalTile.
  	outerPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: rel).    
  	^ outerPhrase!

Item was changed:
  ----- Method: CategoryViewer>>booleanPhraseForGetTurtleOfOfType:retrieverOp:player: (in category 'support') -----
  booleanPhraseForGetTurtleOfOfType: retrieverType retrieverOp: retrieverOp player: aPlayer
  	"Answer a boolean-valued phrase derived from a retriever (e.g. 'car's heading'); this is in order to assure that tiles laid down in a TEST area will indeed produce a boolean result"
  
  	| outerPhrase getterPhrase receiverTile  rel finalTile |
+ 	rel _ (Vocabulary vocabularyForType:  retrieverType) comparatorForSampleBoolean.
+ 	outerPhrase _ PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: retrieverType argType: retrieverType.
+ 	getterPhrase _  PhraseTileMorph new setTurtleOfOperator: retrieverOp type: retrieverType rcvrType: #Player argType: nil.
- 	rel := (Vocabulary vocabularyForType:  retrieverType) comparatorForSampleBoolean.
- 	outerPhrase := PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: retrieverType argType: retrieverType.
- 	getterPhrase :=  PhraseTileMorph new setTurtleOfOperator: retrieverOp type: retrieverType rcvrType: #Player argType: nil.
- 	getterPhrase submorphs third delete.
  	getterPhrase submorphs second setSlotRefOperator: retrieverOp.
- 	"getterPhrase submorphs second setTurtleDefaultTo: scriptedPlayer."
  	getterPhrase submorphs first changeTableLayout.
+ 	receiverTile _ aPlayer tileToRefer bePossessive.
- 	receiverTile := aPlayer tileToRefer bePossessive.
  	"self halt."
  	receiverTile position: getterPhrase firstSubmorph position.
  	getterPhrase firstSubmorph addMorph: receiverTile.
  
  	outerPhrase firstSubmorph addMorph: getterPhrase.
+ 	finalTile _ ScriptingSystem tileForArgType: retrieverType.	"comes with arrows"
- 	finalTile := ScriptingSystem tileForArgType: retrieverType.	"comes with arrows"
  	outerPhrase submorphs last addMorph: finalTile.
  	outerPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: rel).    
  	^ outerPhrase!

Item was changed:
  ----- Method: CategoryViewer>>booleanPhraseForGetUpHillOfType:retrieverOp:player: (in category 'support') -----
  booleanPhraseForGetUpHillOfType: retrieverType retrieverOp: retrieverOp player: aPlayer
  	"Answer a boolean-valued phrase derived from a retriever (e.g. 'car's heading'); this is in order to assure that tiles laid down in a TEST area will indeed produce a boolean result"
  
  	| outerPhrase getterPhrase receiverTile  rel finalTile |
+ 	rel _ (Vocabulary vocabularyForType:  retrieverType) comparatorForSampleBoolean.
+ 	outerPhrase _ PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: retrieverType argType: retrieverType.
+ 	getterPhrase _  PhraseTileMorph new setUpHillOperator: retrieverOp type: retrieverType rcvrType: #Player argType: nil.
- 	rel := (Vocabulary vocabularyForType:  retrieverType) comparatorForSampleBoolean.
- 	outerPhrase := PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: retrieverType argType: retrieverType.
- 	getterPhrase :=  PhraseTileMorph new setUpHillOperator: retrieverOp type: retrieverType rcvrType: #Player argType: nil.
- 	getterPhrase submorphs third delete.
  	getterPhrase submorphs second setSlotRefOperator: retrieverOp.
+ 	getterPhrase submorphs second setArgumentDefaultTo: (scriptedPlayer defaultPatchPlayer).
- 	getterPhrase submorphs second setPatchDefaultTo: (scriptedPlayer defaultPatchPlayer).
  	getterPhrase submorphs first changeTableLayout.
+ 	receiverTile _ aPlayer tileToRefer bePossessive.
- 	receiverTile := aPlayer tileToRefer bePossessive.
  	"self halt."
  	receiverTile position: getterPhrase firstSubmorph position.
  	getterPhrase firstSubmorph addMorph: receiverTile.
  
  	outerPhrase firstSubmorph addMorph: getterPhrase.
+ 	finalTile _ ScriptingSystem tileForArgType: retrieverType.	"comes with arrows"
- 	finalTile := ScriptingSystem tileForArgType: retrieverType.	"comes with arrows"
  	outerPhrase submorphs last addMorph: finalTile.
  	outerPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: rel).    
  	^ outerPhrase!

Item was added:
+ ----- Method: CategoryViewer>>booleanPhraseFromNumericGetterWithArgument: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ 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!

Item was changed:
  ----- Method: CategoryViewer>>booleanPhraseFromPhrase: (in category 'support') -----
  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 isKindOf: ParameterTile) ifTrue: [^ phrase booleanComparatorPhrase].
  	phrase isBoolean ifTrue: [^ phrase].
  	((scriptedPlayer respondsTo: #costume) 
  		and:[scriptedPlayer costume isInWorld not]) ifTrue: [^ Array new].
- 	((retrieverTile := phrase submorphs last) isKindOf: TileMorph) ifFalse: [^ phrase].
- 	retrieverOp := retrieverTile operatorOrExpression.
  
+ 	((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: [
- 			(retrieverOp = #bounceOn:color: or: [retrieverOp = #bounceOnColor:]) ifTrue: [
  				^ self booleanPhraseForBounceOnColorOfType: phrase resultType retrieverOp: retrieverOp player: phrase actualObject.
+ 			]."
+ 			"retrieverOp = #getTurtleAt: ifTrue: [
- 			].
- 			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!

Item was added:
+ ----- Method: CategoryViewer>>categoryNameMorph (in category '*Etoys-Squeakland-categories') -----
+ categoryNameMorph
+ 	"Answer the StringMorph that holds the current category name."
+ 
+ 	^ namePane findA: StringMorph!

Item was changed:
  ----- Method: CategoryViewer>>categoryWording: (in category 'categories') -----
  categoryWording: aCategoryWording
  	"Make the category with the given wording be my current one."
  
+ 	self categoryNameMorph contents: aCategoryWording.
- 	| actualPane |
- 	(actualPane := namePane renderedMorph) firstSubmorph contents: aCategoryWording; color: Color black.
- 	actualPane extent: actualPane firstSubmorph extent.
- 
  	self removeAllButFirstSubmorph. "that being the header"
  	self addAllMorphs:
  		((scriptedPlayer tilePhrasesForCategory: chosenCategorySymbol inViewer: self)).
  	self enforceTileColorPolicy.
  	self secreteCategorySymbol.
  	self world ifNotNil: [self world startSteppingSubmorphsOf: self].
  	self adjustColorsAndBordersWithin.
  
  	owner ifNotNil: [owner isStandardViewer ifTrue: [owner fitFlap]]!

Item was changed:
  ----- Method: CategoryViewer>>chooseCategory (in category 'categories') -----
  chooseCategory
  	"The mouse went down on my category-list control; pop up a list of category choices"
  
+ 	| aList aMenu reply aLinePosition lineList special |
+ 	Cursor wait showWhile: [
+ 	
+ 		aList _ (scriptedPlayer categoriesForViewer: self) asOrderedCollection.
+ 		special :=  {ScriptingSystem nameForScriptsCategory.  ScriptingSystem nameForInstanceVariablesCategory}.
+ 		aList removeAllFoundIn: special.
+ 		aList := special, aList.
+ 		aLinePosition _ aList indexOf: #miscellaneous ifAbsent: [nil].
+ 		aList _ aList collect:	
+ 			[:aCatSymbol | self currentVocabulary categoryWordingAt: aCatSymbol].
- 	| aList reply aLinePosition lineList |
- 	aList := scriptedPlayer categoriesForViewer: self.
  
+ 		lineList _ aLinePosition ifNil: [#(2)] ifNotNil: [Array with: 2 with: aLinePosition].
+ 		aMenu _ CustomMenu labels: aList lines: lineList selections: aList.
+ 		reply _ aMenu startUpWithCaption: 'category' translated.
+ 		reply ifNil: [^ self].
+ 		self chooseCategoryWhoseTranslatedWordingIs: reply asSymbol.
+ 		self assureCategoryFullyVisible
+ 	]!
- 	aLinePosition := aList indexOf: #miscellaneous ifAbsent: [nil].
- 	aList := aList collect:	
- 		[:aCatSymbol | self currentVocabulary categoryWordingAt: aCatSymbol].
- 
- 	lineList := aLinePosition ifNil: [#()] ifNotNil: [Array with: aLinePosition].
- 	aList size = 0 ifTrue: [aList add: ScriptingSystem nameForInstanceVariablesCategory translated].
- 	reply := UIManager default 
- 		chooseFrom: aList 
- 		values: aList 
- 		lines: lineList
- 		title: 'category' translated.
- 	reply ifNil: [^ self].
- 	self chooseCategoryWhoseTranslatedWordingIs: reply asSymbol
- !

Item was changed:
  ----- Method: CategoryViewer>>chosenCategorySymbol: (in category 'categories') -----
  chosenCategorySymbol: aCategorySymbol
  	"Make the given category be my current one."
  
  	| aCategory wording |
+ 	chosenCategorySymbol _ aCategorySymbol.
+ 	aCategory _ self currentVocabulary categoryAt: chosenCategorySymbol.
+ 	wording _ aCategory ifNil: [aCategorySymbol] ifNotNil: [aCategory wording].
+ 	self categoryWording: wording.
+ 	aCategorySymbol asSymbol = #tests ifTrue: [self addMorph: self phraseForTest after: self submorphs first].
+ 
+ 	aCategorySymbol asSymbol = #miscellaneous ifTrue: [self addMorph: self phraseForTimesRepeat after: self submorphs first].
+ !
- 	chosenCategorySymbol := aCategorySymbol.
- 	aCategory := self currentVocabulary categoryAt: chosenCategorySymbol.
- 	wording := aCategory ifNil: [aCategorySymbol] ifNotNil: [aCategory wording].
- 	self categoryWording: wording!

Item was changed:
  ----- Method: CategoryViewer>>currentCategory (in category 'categories') -----
  currentCategory
  	"Answer the symbol representing the receiver's currently-selected category"
  
  	| current |
+ 	current _ self categoryNameMorph contents.
+ 	^ current ifNotNil: [current asSymbol] ifNil: [#basic translated]!
- 	current := namePane renderedMorph firstSubmorph contents.
- 	^ current ifNotNil: [current asSymbol] ifNil: [#basic]!

Item was changed:
  ----- Method: CategoryViewer>>getterTilesFor:type: (in category 'get/set slots') -----
  getterTilesFor: getterSelector type: aType 
  	"Answer classic getter for the given name/type"
  
+ 	"aPhrase _ nil, assumed"
- 	"aPhrase := nil, assumed"
  
  	| selfTile selector aPhrase |
  	(#(#color:sees: #colorSees) includes: getterSelector) 
  		ifTrue: [aPhrase := self colorSeesPhrase].
  	(#(#getPatchValueIn:) includes: getterSelector)
+ 		ifTrue: [aPhrase _ self patchValuePhrase].
- 		ifTrue: [aPhrase := self patchValuePhrase].
  	(#(#getRedComponentIn:) includes: getterSelector)
+ 		ifTrue: [aPhrase _ self colorComponentPhraseFor: #red].
- 		ifTrue: [aPhrase := self colorComponentPhraseFor: #red].
  	(#(#getGreenComponentIn:) includes: getterSelector)
+ 		ifTrue: [aPhrase _ self colorComponentPhraseFor: #green].
- 		ifTrue: [aPhrase := self colorComponentPhraseFor: #green].
  	(#(#getBlueComponentIn:) includes: getterSelector)
+ 		ifTrue: [aPhrase _ self colorComponentPhraseFor: #blue].
- 		ifTrue: [aPhrase := self colorComponentPhraseFor: #blue].
  	(#(#getUphillIn:) includes: getterSelector)
+ 		ifTrue: [aPhrase _ self patchUphillPhrase].
- 		ifTrue: [aPhrase := self patchUphillPhrase].
  	(#(#bounceOn:) includes: getterSelector)
+ 		ifTrue: [aPhrase _ self bounceOnPhrase].
+ "	(#(#bounceOn:color: #bounceOnColor:) includes: getterSelector)
+ 		ifTrue: [aPhrase _ self bounceOnColorPhrase]."
- 		ifTrue: [aPhrase := self bounceOnPhrase].
- 	(#(#bounceOn:color: #bounceOnColor:) includes: getterSelector)
- 		ifTrue: [aPhrase := self bounceOnColorPhrase].
  	(getterSelector = #getDistanceTo:)
+ 		ifTrue: [aPhrase _ self distanceToPhrase].
- 		ifTrue: [aPhrase := self distanceToPhrase].
  	(getterSelector = #getAngleTo:)
+ 		ifTrue: [aPhrase _ self angleToPhrase].
- 		ifTrue: [aPhrase := self angleToPhrase].
  	(getterSelector = #getTurtleOf:)
+ 		ifTrue: [aPhrase _ self turtleOfPhrase].
+ 
+ 	(getterSelector = #distanceToPlayer:)
+ 		ifTrue: [aPhrase _ self distanceToPlayerPhrase].
+ 	(getterSelector = #bearingTo:)
+ 		ifTrue: [aPhrase _ self bearingToPhrase].
+ 	(getterSelector = #bearingFrom:)
+ 		ifTrue: [aPhrase _ self bearingFromPhrase].
+ 
- 		ifTrue: [aPhrase := self turtleOfPhrase].
  	(#(#seesColor: #isOverColor) includes: getterSelector) 
  		ifTrue: [aPhrase := self seesColorPhrase].
  	(#(#overlaps: #overlaps) includes: getterSelector) 
  		ifTrue: [aPhrase := self overlapsPhrase].
  	(#(#overlapsAny: #overlapsAny) includes: getterSelector) 
  		ifTrue: [aPhrase := self overlapsAnyPhrase].
  	(#(#touchesA: #touchesA) includes: getterSelector) 
  		ifTrue: [aPhrase := self touchesAPhrase].
  	aPhrase ifNil: 
  			[aPhrase := PhraseTileMorph new setSlotRefOperator: getterSelector asSymbol
  						type: aType].
  	selfTile := self tileForSelf bePossessive.
  	selfTile position: aPhrase firstSubmorph position.
  	aPhrase firstSubmorph addMorph: selfTile.
  	selector := aPhrase submorphs second.
+ 	
+ 	(#(#getPatchValueIn: getUphillIn: bearingFrom: bearingTo: distanceToPlayer:) includes: getterSelector) ifFalse: [
- 	(#(#getPatchValueIn: getUphillIn:) includes: getterSelector) ifFalse: [
  		(Vocabulary vocabularyNamed: aType capitalized) 
+ 			ifNotNilDo: [:aVocab | aVocab wantsSuffixArrow ifTrue: [selector addSuffixArrow]].
- 			ifNotNil: [:aVocab | aVocab wantsSuffixArrow ifTrue: [selector addSuffixArrow]].
  	].
  	selector updateLiteralLabel.
  	aPhrase enforceTileColorPolicy.
  	^aPhrase!

Item was changed:
  ----- Method: CategoryViewer>>infoButtonFor: (in category 'entries') -----
  infoButtonFor: aScriptOrSlotSymbol
  	"Answer a fully-formed morph that will serve as the 'info button' alongside an entry corresponding to the given slot or script symbol.  If no such button is appropriate, answer a transparent graphic that fills the same space."
  
  	| aButton |
  	(self wantsRowMenuFor: aScriptOrSlotSymbol) ifFalse:
  		["Fill the space with sweet nothing, since there is no meaningful menu to offer"
+ 		aButton _ RectangleMorph new beTransparent extent: (17 at 20).
- 		aButton := RectangleMorph new beTransparent extent: (17 at 20).
  		aButton borderWidth: 0.
  		^ aButton].
  
+ 	aButton _ self menuButton.
- 	aButton := IconicButton new labelGraphic: Cursor menu.
  	aButton target: scriptedPlayer;
  		actionSelector: #infoFor:inViewer:;
+ 		arguments: (Array with:aScriptOrSlotSymbol with: self).
- 		arguments: (Array with:aScriptOrSlotSymbol with: self);
- 		color: Color transparent;
- 		borderWidth: 0;
- 		shedSelvedge;
- 		actWhen: #buttonDown.
  	aButton setBalloonText: 'Press here to get a menu' translated.
  	^ aButton!

Item was changed:
  ----- Method: CategoryViewer>>initializeFor:categoryChoice: (in category 'initialization') -----
  initializeFor: aPlayer categoryChoice: aChoice
  	"Initialize the receiver to be associated with the player and category specified"
  
+ 	scriptedPlayer _ aPlayer.
- 	self listDirection: #topToBottom;
- 		hResizing: #spaceFill;
- 		vResizing: #spaceFill;
- 		borderWidth: 1;
- 		beSticky.
- 	self color: Color green muchLighter muchLighter.
- 	scriptedPlayer := aPlayer.
  	self addHeaderMorph.
  
  	self chooseCategoryWhoseTranslatedWordingIs: aChoice
  !

Item was changed:
  ----- Method: CategoryViewer>>isSpecialPatchCase:and: (in category 'support') -----
  isSpecialPatchCase: aPlayer and: cmd
+ 	"Boolean - Kedama  hook - answer whether the player and command provided represent a 'special patch case'."
  
+ 	aPlayer isPlayerLike ifFalse: [^ false].
  	((aPlayer costume renderedMorph class = KedamaMorph) and: [cmd = #addToPatchDisplayList:]) ifTrue: [
  		^ true.
  	].
  	(aPlayer costume renderedMorph class = KedamaPatchMorph) ifTrue: [
  		(#(#redComponentInto: #greenComponentInto: #blueComponentInto:
  			#redComponentFrom: #greenComponentFrom: #blueComponentFrom:) includes: cmd) ifTrue: [
+ 			^ true.
+ 		].
- 		^ true.
  	].
+ 
+ 	(aPlayer costume renderedMorph class = KedamaTurtleMorph) ifTrue: [
+ 		(#(#colorFromPatch: #colorToPatch:) includes: cmd) ifTrue: [
+ 			^ true.
+ 		].
  	].
  
+ 
  	^ false.
  !

Item was changed:
  ----- Method: CategoryViewer>>isSpecialPatchReceiver:and: (in category 'support') -----
  isSpecialPatchReceiver: aPlayer and: cmd
+ 	"Boolean - Kedama  hook - answer whether it's true both that the object provided is  a Player whose costume is a KedamaPatchMorph AND that the command provided is  one of six special <color>Component<from | to> commands such as #greenComponentFrom: "
  
+ 	^ aPlayer isPlayerLike and: [aPlayer costume renderedMorph class = KedamaPatchMorph] and: [
- 	^ (aPlayer costume renderedMorph class = KedamaPatchMorph) and: [
  		(#(#redComponentInto: #greenComponentInto: #blueComponentInto:
+ 			#redComponentFrom: #greenComponentFrom: #blueComponentFrom:) includes: cmd)].
- 			#redComponentFrom: #greenComponentFrom: #blueComponentFrom:) includes: cmd)
- 	].
  !

Item was changed:
  ----- Method: CategoryViewer>>makeSetterForColorComponent:componentName:event:from: (in category 'get/set slots') -----
  makeSetterForColorComponent: selectorAndTypePair componentName: componentName event: evt from: aMorph 
  
  	| argType m argTile selfTile argValue actualGetter |
  	argType := selectorAndTypePair second.
+ 	componentName = #red ifTrue: [actualGetter _ #setRedComponentIn:].
+ 	componentName = #green ifTrue: [actualGetter _ #setGreenComponentIn:].
+ 	componentName = #blue ifTrue: [actualGetter _ #setBlueComponentIn:].
- 	componentName = #red ifTrue: [actualGetter := #setRedComponentIn:].
- 	componentName = #green ifTrue: [actualGetter := #setGreenComponentIn:].
- 	componentName = #blue ifTrue: [actualGetter := #setBlueComponentIn:].
  	m := PhraseTileMorph new 
  				setColorComponentRoot: actualGetter
  				componentName: componentName
  				type: #command
  				rcvrType: #Patch
  				argType: argType
  				vocabulary: self currentVocabulary.
  	argValue := self scriptedPlayer 
  				perform: selectorAndTypePair first asSymbol with: nil.
  	(argValue isKindOf: Player) 
  		ifTrue: [argTile := argValue tileReferringToSelf]
  		ifFalse: 
  			[argTile := ScriptingSystem tileForArgType: argType.
  			(argType == #Number and: [argValue isNumber]) 
  				ifTrue: 
  					[(scriptedPlayer decimalPlacesForGetter: actualGetter) 
+ 						ifNotNilDo: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]].
- 						ifNotNil: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]].
  			argTile
  				setLiteral: argValue;
  				updateLiteralLabel].
  	argTile position: m lastSubmorph position.
  	m lastSubmorph addMorph: argTile.
  	selfTile := self tileForSelf bePossessive.
  	selfTile position: m firstSubmorph position.
  	m firstSubmorph addMorph: selfTile.
  	m enforceTileColorPolicy.
  	m submorphs second setPatchDefaultTo: scriptedPlayer defaultPatchPlayer.
  
  	m openInHand!

Item was changed:
  ----- Method: CategoryViewer>>makeSetterForGetPatchValue:event:from: (in category 'get/set slots') -----
  makeSetterForGetPatchValue: selectorAndTypePair event: evt from: aMorph 
  
  	| argType m argTile selfTile argValue actualGetter |
  	argType := selectorAndTypePair second.
  	actualGetter := #patchValueIn:.
  	m := PhraseTileMorph new 
  				setPixelValueRoot: actualGetter
  				type: #command
  				rcvrType: #Player
  				argType: argType
  				vocabulary: self currentVocabulary.
  	argValue := self scriptedPlayer 
  				perform: selectorAndTypePair first asSymbol with: nil.
  	(argValue isPlayerLike) 
  		ifTrue: [argTile := argValue tileReferringToSelf]
  		ifFalse: 
  			[argTile := ScriptingSystem tileForArgType: argType.
  			(argType == #Number and: [argValue isNumber]) 
  				ifTrue: 
  					[(scriptedPlayer decimalPlacesForGetter: actualGetter) 
+ 						ifNotNilDo: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]].
- 						ifNotNil: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]].
  			argTile
  				setLiteral: argValue;
  				updateLiteralLabel].
  	argTile position: m lastSubmorph position.
  	m lastSubmorph addMorph: argTile.
  	selfTile := self tileForSelf bePossessive.
  	selfTile position: m firstSubmorph position.
  	m firstSubmorph addMorph: selfTile.
  	m enforceTileColorPolicy.
  	m submorphs second setPatchDefaultTo: scriptedPlayer defaultPatchPlayer.
  
  	m openInHand!

Item was changed:
  ----- Method: CategoryViewer>>phraseForCommandFrom: (in category 'entries') -----
  phraseForCommandFrom: aMethodInterface
  	"Answer a phrase for the non-slot-like command represented by aMethodInterface - classic tiles"
  
  	| aRow resultType cmd names argType argTile selfTile aPhrase balloonTextSelector stat inst aDocString universal tileBearingHelp |
+ 	aDocString _ aMethodInterface documentation.
+ 	aDocString = 'no help available' ifTrue: [aDocString _ nil].
+ 	names _ scriptedPlayer class namedTileScriptSelectors.
- 	aDocString := aMethodInterface documentation.
- 	aDocString = 'no help available' ifTrue: [aDocString := nil].
- 	names := scriptedPlayer class namedTileScriptSelectors.
  
+ 	resultType _ aMethodInterface resultType.
+ 	cmd _ aMethodInterface selector.
+ 	(universal _ scriptedPlayer isUniversalTiles)
- 	resultType := aMethodInterface resultType.
- 	cmd := aMethodInterface selector.
- 	(universal := scriptedPlayer isUniversalTiles)
  		ifTrue:
+ 			[aPhrase _ scriptedPlayer universalTilesForInterface: aMethodInterface]
+ 		ifFalse: [cmd numArgs == 0
- 			[aPhrase := scriptedPlayer universalTilesForInterface: aMethodInterface]
- 		ifFalse: [cmd numArgs = 0
  			ifTrue:
+ 				[aPhrase _ PhraseTileMorph new vocabulary: self currentVocabulary.
- 				[aPhrase := PhraseTileMorph new vocabulary: self currentVocabulary.
  				aPhrase setOperator: cmd
  					type: resultType
  					rcvrType: #Player]
  			ifFalse:
  				["only one arg supported in classic tiles, so if this is fed
  				with a selector with > 1 arg, results will be very strange"
+ 				argType _ aMethodInterface typeForArgumentNumber: 1.
+ 				aPhrase _ PhraseTileMorph new vocabulary: self currentVocabulary.
- 				argType := aMethodInterface typeForArgumentNumber: 1.
- 				aPhrase := PhraseTileMorph new vocabulary: self currentVocabulary.
  				(self isSpecialPatchReceiver: scriptedPlayer and: cmd) ifTrue: [
  					aPhrase setOperator: cmd
  						type: resultType
  						rcvrType: #Patch
  						argType: argType.
  				] ifFalse: [
  					aPhrase setOperator: cmd
  						type: resultType
  						rcvrType: #Player
  						argType: argType.
  				].
  				(self isSpecialPatchCase: scriptedPlayer and: cmd) ifTrue: [
+ 					argTile _ (Vocabulary vocabularyForType: argType) defaultArgumentTileFor: scriptedPlayer.
- 					argTile := (Vocabulary vocabularyForType: argType) defaultArgumentTileFor: scriptedPlayer.
  				] ifFalse: [
+ 					argTile _ ScriptingSystem tileForArgType: argType forCommand: cmd.
- 					argTile := ScriptingSystem tileForArgType: argType.
  				].
  				(#(bounce: wrap:) includes: cmd) ifTrue:
  					["help for the embattled bj"
  					argTile setLiteral: 'silence'; updateLiteralLabel].
  				argTile position: aPhrase lastSubmorph position.
  				aPhrase lastSubmorph addMorph: argTile]].
  
  	(scriptedPlayer slotInfo includesKey: cmd)
+ 		ifTrue: [balloonTextSelector _ #userSlot].
- 		ifTrue: [balloonTextSelector := #userSlot].
  
  	(scriptedPlayer belongsToUniClass and: [scriptedPlayer class includesSelector: cmd])
  		ifTrue:
  			[aDocString ifNil:
+ 				[aDocString _ (scriptedPlayer class userScriptForPlayer: scriptedPlayer selector: cmd) documentation].
- 				[aDocString := (scriptedPlayer class userScriptForPlayer: scriptedPlayer selector: cmd) documentation].
  			aDocString ifNil:
+ 				[balloonTextSelector _ #userScript]].
- 				[balloonTextSelector := #userScript]].
  
+ 	tileBearingHelp _ universal ifTrue: [aPhrase submorphs second] ifFalse: [aPhrase operatorTile]. 
- 	tileBearingHelp := universal ifTrue: [aPhrase submorphs second] ifFalse: [aPhrase operatorTile]. 
  	aDocString
  		ifNotNil:
  			[tileBearingHelp setBalloonText: aDocString]
  		ifNil:
  			[balloonTextSelector ifNil:
  				[tileBearingHelp setProperty: #inherentSelector toValue: cmd.
+ 				balloonTextSelector _ nil].
- 				balloonTextSelector := #methodComment].
  			tileBearingHelp balloonTextSelector: balloonTextSelector].
  	aPhrase markAsPartsDonor.
  	cmd == #emptyScript ifTrue:
  		[aPhrase setProperty: #newPermanentScript toValue: true.
  		aPhrase setProperty: #newPermanentPlayer toValue: scriptedPlayer.
  		aPhrase submorphs second setBalloonText: 
  'drag and drop to 
  add a new script' translated].
  
  	universal ifFalse:
+ 		[selfTile _ self tileForSelf.
- 		[selfTile := self tileForSelf.
  		selfTile position: aPhrase firstSubmorph position.
  		aPhrase firstSubmorph addMorph: selfTile].
  
+ 	aRow _ ViewerLine newRow.
- 	aRow := ViewerLine newRow borderWidth: 0; color: self color.
  	aRow elementSymbol: cmd asSymbol.
  
+ 	aRow addMorphBack: (
+ 		(balloonTextSelector = #userSlot)
+ 			ifTrue: [(self infoButtonFor: cmd)]
+ 			ifFalse: [cmd = #emptyScript
+ 				ifTrue: [ScriptingSystem buttonSpacer]
+ 				ifFalse: [ScriptingSystem tryButtonFor: aPhrase]]).
+ 
+ 	aRow addMorphBack: self spacerAfterButton.
+ 
- 	aRow addMorphBack: (ScriptingSystem tryButtonFor: aPhrase).
- 	aRow addMorphBack: (Morph new extent: 2 at 2; beTransparent).
- 	aRow addMorphBack: (self infoButtonFor: cmd).
  	aRow addMorphBack: aPhrase.
+ 	"aPhrase on: #mouseEnter send: #addCommandFeedback to: aRow.
- 	aPhrase on: #mouseEnter send: #addCommandFeedback to: aRow.
  	aPhrase on: #mouseLeave send: #removeHighlightFeedback to: aRow.
+ 	aPhrase on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow."
- 	aPhrase on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow.
  
  	(names includes: cmd) ifTrue:
  		[aPhrase userScriptSelector: cmd.
+ 		cmd numArgs == 0 ifTrue:
- 		cmd numArgs = 0 ifTrue:
  			[aPhrase beTransparent.
  			aRow addMorphBack: AlignmentMorph newVariableTransparentSpacer.
+ 			aRow addMorphBack: (stat _ (inst _ scriptedPlayer scriptInstantiationForSelector: cmd) statusControlMorph).
- 			aRow addMorphBack: (stat := (inst := scriptedPlayer scriptInstantiationForSelector: cmd) statusControlMorph).
  			inst updateStatusMorph: stat]].
  
  	aRow beSticky; disableDragNDrop.
  
  	^ aRow!

Item was added:
+ ----- Method: CategoryViewer>>phraseForTest (in category '*Etoys-Squeakland-entries') -----
+ phraseForTest
+ 	"Answer a phrase for the non-slot-like command represented by aMethodInterface - classic tiles"
+ 
+ 	| aPhrase aRow |
+ 	aPhrase _ PhraseTileForTest new.
+ 	aRow _ ViewerLine newRow.
+ 	aRow addMorphBack: ScriptingSystem buttonSpacer.
+ 	aRow addMorphBack: self spacerAfterButton.
+ 	aRow addMorphBack: aPhrase.
+ 	aRow setBalloonText: 'Press here to tear off a TEST/YES/NO unit which you can drop into your script' translated.
+ 	^ aRow.
+ !

Item was added:
+ ----- Method: CategoryViewer>>phraseForTimesRepeat (in category '*Etoys-Squeakland-entries') -----
+ phraseForTimesRepeat
+ 	"Answer a phrase representing times/repeat"
+ 
+ 	| aPhrase aRow |
+ 	aPhrase _ PhraseTileForTimesRepeat new.
+ 	aRow _ ViewerLine newRow.
+ 	aRow addMorphBack: ScriptingSystem buttonSpacer.
+ 	aRow addMorphBack: self spacerAfterButton.
+ 	aRow addMorphBack: aPhrase.
+ 	aRow setBalloonText: 'Drag here to tear off a Repeat/Times unit which you can drop into your script' translated.
+ 	^ aRow.
+ !

Item was changed:
  ----- Method: CategoryViewer>>readoutFor:type:readOnly:getSelector:putSelector: (in category 'entries') -----
  readoutFor: partName type: partType readOnly: readOnly getSelector: getSelector putSelector: putSelector
  	"Answer a readout morph for the given part"
  
  	| readout delta |
+ 	readout _ (Vocabulary vocabularyForType: partType) updatingTileForTarget: scriptedPlayer partName: partName getter: getSelector setter: putSelector.
- 	readout := (Vocabulary vocabularyForType: partType) updatingTileForTarget: scriptedPlayer partName: partName getter: getSelector setter: putSelector.
  
  	(partType == #Number) ifTrue:
+ 		[(delta _ scriptedPlayer arrowDeltaFor: getSelector) = 1
- 		[(delta := scriptedPlayer arrowDeltaFor: getSelector) = 1
  			ifFalse:
  				[readout setProperty: #arrowDelta toValue: delta].
  		scriptedPlayer setFloatPrecisionFor: readout updatingStringMorph].
  
+ 	partType == #Point ifTrue:
+ 		[scriptedPlayer setFloatPrecisionFor: readout updatingStringMorph].
+ 
  	readout step.
  	^ readout!

Item was changed:
  ----- Method: CategoryViewer>>showCategoriesFor: (in category 'categories') -----
  showCategoriesFor: aSymbol
  	"Put up a pop-up list of categories in which aSymbol is filed; replace the receiver with a CategoryViewer for the one the user selects, if any"
  
+ 	| allCategories aVocabulary hits meths chosen aMenu aCaption symbolToReport |
+ 	aVocabulary _ self currentVocabulary.
+ 	allCategories _ scriptedPlayer categoriesForVocabulary: aVocabulary limitClass: ProtoObject.
- 	| allCategories aVocabulary hits chosen |
- 	aVocabulary := self currentVocabulary.
- 	allCategories := scriptedPlayer categoriesForVocabulary: aVocabulary limitClass: ProtoObject.
  
+ 	hits _ allCategories select:
- 	hits := allCategories select:
  		[:aCategory | 
+ 			meths _ aVocabulary allMethodsInCategory: aCategory forInstance: scriptedPlayer ofClass: scriptedPlayer class.
- 			| meths |
- 			meths := aVocabulary allMethodsInCategory: aCategory forInstance: scriptedPlayer ofClass: scriptedPlayer class.
  			meths includes: aSymbol].
  
+ 	hits isEmpty ifTrue: [^ self inform: 'this tile is not actually suitable for use with this kind of object' translated].
- 	hits isEmpty ifTrue: [ ^self ].
  
+ 	symbolToReport := (aSymbol beginsWith: 'get') ifTrue: [Utilities inherentSelectorForGetter: aSymbol] ifFalse: [aSymbol].
+ 
+ 	aMenu := SelectionMenu selections: hits.
+ 	aCaption := hits size = 1
+ 		ifTrue:
+ 			 ['is in the following category' translated]
+ 		ifFalse:
+ 			['can be found in the following categories' translated].
+ 
+ 	chosen _ aMenu startUpWithCaption:  symbolToReport, ' ', aCaption.
- 	chosen := UIManager default chooseFrom: hits values: hits.
  	chosen isEmptyOrNil ifFalse:
  		[self outerViewer addCategoryViewerFor: chosen atEnd: true]
  
  	!

Item was added:
+ ----- Method: CategoryViewer>>spacerAfterButton (in category '*Etoys-Squeakland-entries') -----
+ spacerAfterButton
+ 	^ Morph new extent: 2 @ 0;
+ 		 beTransparent!

Item was added:
+ ----- Method: CategoryViewer>>universalTilesPhraseForVariableFrom: (in category '*Etoys-Squeakland-entries') -----
+ universalTilesPhraseForVariableFrom: aMethodInterface
+ 	"The universal-tiles variant of phraseForVariableFrom:...  Split out to preserve it, somewhat, though we're not using universal tiles any more, presuambly ever again (indeed we never did) but for convenience moved here so that 'universal' code doesn't becloud #phraseForVariableFrom:"
+ 
+ 	| anArrow slotName getterButton cover inner aRow doc setter tryer |
+ 	aRow _ ViewerLine newRow
+ 		elementSymbol: (slotName _ aMethodInterface selector);
+ 		wrapCentering: #center;
+ 		cellPositioning: #leftCenter.
+ 
+ 	(self wantsInfoButtonFor: slotName)
+ 		ifFalse:
+ 			[aRow addMorphBack: ScriptingSystem buttonSpacer]
+ 		ifTrue:
+ 			[aRow addMorphBack: (self infoButtonFor: slotName)].
+ 
+ 	aRow addMorphBack: self spacerAfterButton.
+ 
+ 	inner _ scriptedPlayer universalTilesForGetterOf: aMethodInterface.
+ 			cover _ Morph new color: Color transparent.
+ 			cover extent: inner fullBounds extent.
+ 			(getterButton _ cover copy) addMorph: cover; addMorphBack: inner.
+ 			cover on: #mouseDown send: #makeUniversalTilesGetter:event:from: 
+ 					to: self withValue: aMethodInterface.
+ 			aRow addMorphFront:  (tryer _ ScriptingSystem tryButtonFor: inner).
+ 			tryer color: tryer color lighter lighter.
+ 	aRow addMorphBack: getterButton.
+ 	getterButton on: #mouseEnter send: #addGetterFeedback to: aRow.
+ 	getterButton on: #mouseLeave send: #removeHighlightFeedback to: aRow.
+ 	getterButton on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow.
+ 	(doc _ aMethodInterface documentation) ifNotNil:
+ 		[getterButton setBalloonText: doc].
+ 
+ 	aRow addMorphBack: (AlignmentMorph new beTransparent).  "flexible spacer"
+ 	(setter _ aMethodInterface companionSetterSelector) ifNotNil:
+ 		[aRow addMorphBack: (Morph new color: self color; extent: 2 at 10).  " spacer"
+ 		anArrow _ self arrowSetterButton: #newMakeSetterFromInterface:evt:from:  
+ 						args: aMethodInterface.
+ 		anArrow beTransparent.
+ 
+ 		aRow addMorphBack: anArrow].
+ 
+ 	anArrow ifNotNil: [anArrow step].
+ 	^ aRow!

Item was changed:
  ----- Method: CategoryViewer>>updateCategoryNameTo: (in category 'categories') -----
  updateCategoryNameTo: aName
  	"Update the category name, because of a language change."
  
+ 	self categoryNameMorph contents: aName; color: Color black.
+ 	namePane height: TileMorph defaultH. 
+ 	self world ifNotNil: [self world startSteppingSubmorphsOf: self]!
- 	| actualPane |
- 	(actualPane := namePane firstSubmorph) contents: aName; color: Color black.
- 	namePane extent: actualPane extent.
- 	self world ifNotNil: [self world startSteppingSubmorphsOf: self]
- !

Item was added:
+ ----- Method: CategoryViewer>>wantsInfoButtonFor: (in category '*Etoys-Squeakland-entries') -----
+ wantsInfoButtonFor: slotName
+ 	"Answer whether a menu button is desired in a viewer for a slot of the given name."
+ 
+ 	^ (#(color:sees: seesColor: overlaps: overlapsAny: touchesA:) includes: slotName) not!

Item was changed:
  ----- Method: CategoryViewer>>wantsRowMenuFor: (in category 'entries') -----
  wantsRowMenuFor: aSymbol
  	"Answer whether a viewer row for the given symbol should have a menu button on it"
  
  	| elementType |
  
  	true ifTrue: [^ true].  "To allow show categories item.  So someday this method can be removed, and its sender can stop sending it..."
  
+ 	elementType _ scriptedPlayer elementTypeFor: aSymbol vocabulary: self currentVocabulary.
- 	elementType := scriptedPlayer elementTypeFor: aSymbol vocabulary: self currentVocabulary.
  	(elementType == #systemScript) ifTrue: [^ false].
  	((elementType == #systemSlot) and:
+ 		[#(color:sees: touchesA: overlaps: overlapsAny: distanceToPlayer: bearingTo: bearingFrom:) includes: aSymbol]) ifTrue: [^ false].
- 		[#(color:sees: touchesA: overlaps: overlapsAny:) includes: aSymbol]) ifTrue: [^ false].
  	^ true!

Item was added:
+ WorldViewModel subclass: #CautiousModel
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-ST80-Morphic'!
+ 
+ !CautiousModel commentStamp: '<historical>' prior: 0!
+ A model for a morphic world view which will ask for confirmation before being closed, unless the corresponding preference is set to false. !

Item was added:
+ ----- Method: CautiousModel>>okToChange (in category 'updating') -----
+ okToChange
+ 	Preferences cautionBeforeClosing ifFalse: [^ true].
+ 	Sensor leftShiftDown ifTrue: [^ true].
+ 
+ 	Beeper beep.
+ 	^ self confirm: 'Warning!!
+ If you answer "yes" here, this
+ window will disappear and
+ its contents will be lost!!
+ Do you really want to do that?'
+ 
+ "CautiousModel new okToChange"!

Item was added:
+ BroomMorphDown subclass: #CenterBroomMorphDown
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-BroomMorphs-Base'!

Item was added:
+ ----- Method: CenterBroomMorphDown>>affectedMorphs (in category 'private') -----
+ affectedMorphs
+ 	"Answer all the morphs that I should be moving"
+ 	| movedRect |
+ 	movedRect _ self bounds encompass: hotspot x @ lastHotspot y.
+ 	^ owner submorphs
+ 		select: [:m | movedRect
+ 				intersects: (Rectangle
+ 						left: m bounds left
+ 						right: m bounds right
+ 						top: m bounds center y - 1
+ 						bottom: m bounds center y + 1)]!

Item was added:
+ ----- Method: CenterBroomMorphDown>>positionMorph:originalBounds: (in category 'private') -----
+ positionMorph: m originalBounds: b
+ 	m center: m center x @ (self bottom max: b center y)!

Item was added:
+ BroomMorphLeft subclass: #CenterBroomMorphLeft
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-BroomMorphs-Base'!

Item was added:
+ ----- Method: CenterBroomMorphLeft>>affectedMorphs (in category 'private') -----
+ affectedMorphs
+ 	"Answer all the morphs that I should be moving"
+ 	| movedRect |
+ 	movedRect _ self bounds encompass: lastHotspot x @ hotspot y.
+ 	^ owner submorphs
+ 		select: [:m | movedRect
+ 				intersects: (Rectangle
+ 						left: m bounds center x - 1
+ 						right: m bounds center x + 1
+ 						top: m bounds top
+ 						bottom: m bounds bottom)]!

Item was added:
+ ----- Method: CenterBroomMorphLeft>>positionMorph:originalBounds: (in category 'private') -----
+ positionMorph: m originalBounds: b
+ 	m center: (self left min: b center x) @ m center y!

Item was added:
+ BroomMorphRight subclass: #CenterBroomMorphRight
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-BroomMorphs-Base'!

Item was added:
+ ----- Method: CenterBroomMorphRight>>affectedMorphs (in category 'private') -----
+ affectedMorphs
+ 	"Answer all the morphs that I should be moving"
+ 	| movedRect |
+ 	movedRect _ self bounds encompass: lastHotspot x @ hotspot y.
+ 	^ owner submorphs
+ 		select: [:m | movedRect
+ 				intersects: (Rectangle
+ 						left: m bounds center x - 1
+ 						right: m bounds center x + 1
+ 						top: m bounds top
+ 						bottom: m bounds bottom)]!

Item was added:
+ ----- Method: CenterBroomMorphRight>>positionMorph:originalBounds: (in category 'private') -----
+ positionMorph: m originalBounds: b
+ 	m center: (self right max: b center x) @ m center y!

Item was added:
+ BroomMorphUp subclass: #CenterBroomMorphUp
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-BroomMorphs-Base'!

Item was added:
+ ----- Method: CenterBroomMorphUp>>affectedMorphs (in category 'private') -----
+ affectedMorphs
+ 	"Answer all the morphs that I should be moving"
+ 	| movedRect |
+ 	movedRect _ self bounds encompass: hotspot x @ lastHotspot y.
+ 	^ owner submorphs
+ 		select: [:m | movedRect
+ 				intersects: (Rectangle
+ 						left: m bounds left
+ 						right: m bounds right
+ 						top: m bounds center y - 1
+ 						bottom: m bounds center y + 1)]!

Item was added:
+ ----- Method: CenterBroomMorphUp>>positionMorph:originalBounds: (in category 'private') -----
+ positionMorph: m originalBounds: b
+ 	m center: m center x @ (self top min: b center y)!

Item was added:
+ ----- Method: ChangeSet>>checkForSUnit (in category '*Etoys-Squeakland-fileIn/Out') -----
+ checkForSUnit
+ 	| testClasses changeTypes |
+ 	testClasses := self changedClasses
+ 				select: [:each | each inheritsFrom: TestCase].
+ 	^ testClasses
+ 		select: [:each | 
+ 			changeTypes := self classChangeAt: each name.
+ 			((changeTypes includes: #add)
+ 				or: [changeTypes includes: #change]) not]!

Item was added:
+ ElementCategory subclass: #ChangeSetCategory
+ 	instanceVariableNames: 'membershipSelector'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tools-Changes'!
+ 
+ !ChangeSetCategory commentStamp: '<historical>' prior: 0!
+ A ChangeSetCategory represents a list of change sets to be shown in a ChangeSorter.  It computes whether a given change set is in the list by sending its membershipSelector to ChangeSorter (i.e. the class object) with the change set as message argument.!

Item was added:
+ ----- Method: ChangeSetCategory>>acceptsManualAdditions (in category 'queries') -----
+ acceptsManualAdditions
+ 	"Answer whether the user is allowed manually to manipulate the contents of the change-set-category."
+ 
+ 	^ false!

Item was added:
+ ----- Method: ChangeSetCategory>>changeSetList (in category 'queries') -----
+ changeSetList
+ 	"Answer the list of change-set names in the category"
+ 
+ 	| aChangeSet |
+ 	self reconstituteList.
+ 	keysInOrder size == 0 ifTrue:
+ 		["don't tolerate emptiness, because ChangeSorters gag when they have no change-set selected"
+ 		aChangeSet _ ChangeSorter assuredChangeSetNamed: 'New Changes'.
+ 		self elementAt: aChangeSet name put: aChangeSet].
+ 	^ keysInOrder reversed!

Item was added:
+ ----- Method: ChangeSetCategory>>defaultChangeSetToShow (in category 'miscellaneous') -----
+ defaultChangeSetToShow
+ 	"Answer the name of a change-set to show"
+ 
+ 	^ ChangeSet current!

Item was added:
+ ----- Method: ChangeSetCategory>>fileOutAllChangeSets (in category 'services') -----
+ fileOutAllChangeSets
+ 	"File out all the nonempty change sets in the current category, suppressing the checks for slips that might otherwise ensue.  Obtain user confirmation before undertaking this possibly prodigious task."
+ 
+ 	| aList |
+ 	aList _ self elementsInOrder select:
+ 		[:aChangeSet  | aChangeSet isEmpty not].
+ 	aList size == 0 ifTrue: [^ self inform: 'sorry, all the change sets in this category are empty'].
+ 	(self confirm: 'This will result in filing out ', aList size printString, ' change set(s)
+ Are you certain you want to do this?') ifFalse: [^ self].
+ 
+ 	Preferences setFlag: #checkForSlips toValue: false during: 
+ 		[ChangeSorter fileOutChangeSetsNamed: (aList collect: [:m | m name]) asSortedArray]!

Item was added:
+ ----- Method: ChangeSetCategory>>fillAggregateChangeSet (in category 'services') -----
+ fillAggregateChangeSet
+ 	"Create a change-set named Aggregate and pour into it all the changes in all the change-sets of the currently-selected category"
+ 
+ 	| aggChangeSet |
+ 	aggChangeSet _  ChangeSorter assuredChangeSetNamed: #Aggregate.
+ 	aggChangeSet clear.
+ 	aggChangeSet setPreambleToSay: '"Change Set:		Aggregate
+ Created at ', Time now printString, ' on ', Date today printString, ' by combining all the changes in all the change sets in the category ', categoryName printString, '"'.
+ 
+ 	(self elementsInOrder copyWithout: aggChangeSet) do:
+ 		[:aChangeSet  | aggChangeSet assimilateAllChangesFoundIn: aChangeSet].
+ 	Smalltalk isMorphic ifTrue: [SystemWindow wakeUpTopWindowUponStartup] 
+ !

Item was added:
+ ----- Method: ChangeSetCategory>>hasChangeForClassName:selector:otherThanIn: (in category 'queries') -----
+ hasChangeForClassName: aClassName selector: aSelector otherThanIn: excludedChangeSet
+ 	"Answer whether any change set in this category, other than the excluded one, has a change marked for the given class and selector"
+ 
+ 	self elementsInOrder do:
+ 		[:aChangeSet |
+ 			(aChangeSet ~~ excludedChangeSet and:
+ 				[((aChangeSet methodChangesAtClass: aClassName) includesKey: aSelector)]) ifTrue:	[^ true]].
+ 
+ 	^ false!

Item was added:
+ ----- Method: ChangeSetCategory>>includesChangeSet: (in category 'queries') -----
+ includesChangeSet: aChangeSet
+ 	"Answer whether the receiver includes aChangeSet in its retrieval list"
+ 
+ 	^ ChangeSorter perform: membershipSelector with: aChangeSet!

Item was added:
+ ----- Method: ChangeSetCategory>>membershipSelector: (in category 'initialization') -----
+ membershipSelector: aSelector
+ 	"Set the membershipSelector"
+ 
+ 	membershipSelector _ aSelector!

Item was added:
+ ----- Method: ChangeSetCategory>>reconstituteList (in category 'miscellaneous') -----
+ reconstituteList
+ 	"Clear out the receiver's elements and rebuild them"
+ 
+ 	| newMembers |
+ 	"First determine newMembers and check if they have not changed..."
+ 	newMembers _ ChangeSorter allChangeSets select:
+ 		[:aChangeSet | ChangeSorter perform: membershipSelector with: aChangeSet].
+ 	(newMembers collect: [:cs | cs name]) = keysInOrder ifTrue: [^ self  "all current"].
+ 
+ 	"Things have changed.  Need to recompute the whole category"
+ 	self clear.
+ 	newMembers do:
+ 		[:aChangeSet | self fasterElementAt: aChangeSet name asSymbol put: aChangeSet] 
+ !

Item was added:
+ ChangeSetCategory subclass: #ChangeSetCategoryWithParameters
+ 	instanceVariableNames: 'parameters'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tools-Changes'!

Item was added:
+ ----- Method: ChangeSetCategoryWithParameters>>acceptsManualAdditions (in category 'as yet unclassified') -----
+ acceptsManualAdditions
+ 	"Answer whether the user is allowed manually to manipulate the contents of the change-set-category."
+ 
+ 	^ true!

Item was added:
+ ----- Method: ChangeSetCategoryWithParameters>>addChangeSet: (in category 'as yet unclassified') -----
+ addChangeSet: aChangeSet
+ 	self inform: 'sorry, you can''t do that'!

Item was added:
+ ----- Method: ChangeSetCategoryWithParameters>>includesChangeSet: (in category 'as yet unclassified') -----
+ includesChangeSet: aChangeSet
+ 	"Answer whether the receiver includes aChangeSet in its retrieval list"
+ 
+ 	^ ChangeSorter perform: membershipSelector withArguments: { aChangeSet } , parameters!

Item was added:
+ ----- Method: ChangeSetCategoryWithParameters>>parameters: (in category 'as yet unclassified') -----
+ parameters: anArray
+ 	parameters _ anArray!

Item was added:
+ ----- Method: ChangeSetCategoryWithParameters>>reconstituteList (in category 'as yet unclassified') -----
+ reconstituteList
+ 	"Clear out the receiver's elements and rebuild them"
+ 
+ 	| newMembers |
+ 	"First determine newMembers and check if they have not changed..."
+ 	newMembers _ ChangeSorter allChangeSets select:
+ 		[:aChangeSet | ChangeSorter perform: membershipSelector withArguments: { aChangeSet }, parameters].
+ 	(newMembers collect: [:cs | cs name]) = keysInOrder ifTrue: [^ self  "all current"].
+ 
+ 	"Things have changed.  Need to recompute the whole category"
+ 	self clear.
+ 	newMembers do:
+ 		[:aChangeSet | self fasterElementAt: aChangeSet name asSymbol put: aChangeSet]!

Item was added:
+ Object subclass: #CharRecog
+ 	instanceVariableNames: 'mp p sts pts bmin bmax op cPat in dirs ftrs prevFeatures textMorph'
+ 	classVariableNames: 'CharacterDictionary'
+ 	poolDictionaries: 'TextConstants'
+ 	category: 'Etoys-Squeakland-System-Support'!
+ 
+ !CharRecog commentStamp: '<historical>' prior: 0!
+ Alan Kay's "one-page" character recognizer.  Currently hooked up to text panes and to text morphs, such that you can get it started by hitting cmd-r in such text area that currently has focus.  
+ 
+ To reinitialize the recognition dictionary, evaluate
+ 
+ 	CharRecog reinitializeCharacterDictionary
+ 
+  !

Item was added:
+ ----- Method: CharRecog class>>initialize (in category 'initialization') -----
+ initialize
+ 	"Iniitialize the character dictionary if it doesn't exist yet.  2/5/96 sw"
+ 
+ 	CharacterDictionary == nil ifTrue:
+ 		[CharacterDictionary _ Dictionary new]!

Item was added:
+ ----- Method: CharRecog class>>readRecognizerDictionaryFrom: (in category 'saving dictionary') -----
+ readRecognizerDictionaryFrom: aFileName
+ 	"Read a fresh version of the Recognizer dictionary in from a file of the given name.  7/26/96 sw"
+ 	"CharRecog readRecognizerDictionaryFrom: 'RecogDictionary.2 fixed'"
+ 
+    | aReferenceStream |
+    aReferenceStream _ ReferenceStream fileNamed: aFileName.
+    CharacterDictionary _ aReferenceStream next.
+    aReferenceStream close.
+ !

Item was added:
+ ----- Method: CharRecog class>>reinitializeCharacterDictionary (in category 'initialization') -----
+ reinitializeCharacterDictionary
+ 	"Reset the character dictionary to be empty, ready for a fresh start.  2/5/96 sw"
+ 
+ 	CharacterDictionary _ Dictionary new
+ 
+ "CharRecog reinitializeCharacterDictionary" !

Item was added:
+ ----- Method: CharRecog class>>saveRecognizerDictionaryTo: (in category 'saving dictionary') -----
+ saveRecognizerDictionaryTo: aFileName
+ 	"Save the current state of the Recognizer dictionary to disk.  7/26/96 sw"
+ 
+    | aReferenceStream |
+ aReferenceStream _ ReferenceStream fileNamed: aFileName.
+    aReferenceStream nextPut: CharacterDictionary.
+    aReferenceStream close!

Item was added:
+ ----- Method: CharRecog>>directionFrom:to: (in category 'historical & disused') -----
+ directionFrom: p1 to: p2 | ex |
+ 
+ "This does 8 directions and is not used in current recognizer"
+ "get the bounding box"		ex _ p2 - p1. "unlike bmax-bmin, this can have negatives"
+ 
+ "Look for degenerate forms first: . - |"
+ "look for a dot"				ex abs < (3 at 3) ifTrue: [^' dot... '].
+ "look for hori line"			((ex y = 0) or: [(ex x/ex y) abs > 2]) ifTrue:
+ 	"look for w-e"					[ex x > 0 ifTrue:[^' we-- ']
+ 	"it's an e-w"						ifFalse:[^' ew-- ']].
+ "look for vertical line"		((ex x = 0) or: [(ex y/ex x) abs > 2]) ifTrue:
+ 	"look for n-s"				[(ex y > 0) ifTrue:[ ^' ns||']
+ 	"it's a s-n"						ifFalse:[^' sn|| ']].
+ "look for a diagonal"			(ex x/ex y) abs <= 2 ifTrue:
+ 	"se or ne"					[ex x > 0 ifTrue:[ex y > 0 ifTrue:[^' se// ']. ^' ne// '].
+ 	"sw or nw"									ex y > 0 ifTrue:[^' sw// ']. ^' nw// '].
+ !

Item was added:
+ ----- Method: CharRecog>>extractFeatures (in category 'recognizer') -----
+ extractFeatures | xl xr yl yh reg px py |
+ "get extent bounding box"	in _ bmax - bmin. 
+ 
+ "Look for degenerate forms first: . - |"
+ "look for a dot"				in < (3 at 3) ifTrue: [^' dot... '].
+ 
+ "Feature 5: turns (these are already in ftrs)"
+ 
+ "Feature 4: absolute size"	in < (10 at 10) ifTrue: [ftrs _  'SML ', ftrs] ifFalse:
+ 							[in <=  (70 at 70) ifTrue: [ftrs _ 'REG ', ftrs] ifFalse:
+ 							[in > (70 at 70) ifTrue: [ftrs _ 'LRG ', ftrs]]].
+ 
+ "Feature 3: aspect ratio"
+ 	"horizontal shape"		((in y = 0) or: [(in x/in y) abs > 3]) ifTrue:
+ 								[ftrs _ 'HOR ', ftrs] ifFalse:
+ 	"vertical shape"			[((in x = 0) or: [(in y/in x) abs >= 3]) ifTrue:
+ 								[ftrs _ 'VER ', ftrs] ifFalse:
+ 	"boxy shape"			[((in x/in y) abs <= 3) ifTrue:
+ 								[ftrs _ 'BOX ', ftrs.
+ "Now only for boxes"
+ "Feature 2: endstroke reg"	ftrs _ (self regionOf: (pts last)), ftrs.
+ 							
+ "Feature 1: startstroke reg"	ftrs _ (self regionOf: (pts contents at: 1)), ftrs.]]].
+ 
+ ^ftrs
+ 
+ 
+ 
+ !

Item was added:
+ ----- Method: CharRecog>>fourDirsFrom:to: (in category 'recognizer') -----
+ fourDirsFrom:  p1 to: p2 | ex |
+ 
+ "get the bounding box"		ex _ p2 - p1. "unlike bmax-bmin, this can have negatives"
+ 
+ "Look for degenerate forms first: . - |"
+ "look for a dot"				ex abs < (3 at 3) ifTrue: [^' dot... '].
+ "look for hori line"			((ex y = 0) or: [(ex x/ex y) abs > 1]) ifTrue:
+ 	"look for w-e"					[ex x > 0 ifTrue:[^'WE ']
+ 	"it's an e-w"						ifFalse:[^'EW ']].
+ "look for vertical line"		((ex x = 0) or: [(ex y/ex x) abs >= 1]) ifTrue:
+ 	"look for n-s"				[(ex y > 0) ifTrue:[ ^'NS ']
+ 	"it's a s-n"						ifFalse:[^'SN ']].
+ 
+ "look for a diagonal			(ex x/ex y) abs <= 2 ifTrue:"
+ 	"se or ne					[ex x > 0 ifTrue:[ex y > 0 ifTrue:[^' se// ']. ^' ne// ']."
+ 	"sw or nw									ex y > 0 ifTrue:[^' sw// ']. ^' nw// ']."
+ !

Item was added:
+ ----- Method: CharRecog>>learnPrev (in category 'historical & disused') -----
+ learnPrev
+ 	"The character recognized before this one was wrong.  (Got here via the gesture for 'wrong'.)  Bring up a dialog box on that char.  8/21/96 tk"
+ 
+ 						| old result |
+ 	old _ CharacterDictionary at: prevFeatures ifAbsent: [^ ''].
+ "get right char from user"	result _ FillInTheBlank request:
+ 						('Redefine the gesture we thought was "', old asString, '".', '
+ (Letter or:  tab  cr  wrong  bs  select  caret)
+ ', prevFeatures).
+ 
+ "ignore or..."				(result = '~' | result = '') ifTrue: ['']
+ "...enter new char"			ifFalse: [
+ 								CharacterDictionary at: prevFeatures 
+ 									put: result].
+ 					"caller erases bad char"
+ "good char"			^ result!

Item was added:
+ ----- Method: CharRecog>>recogPar (in category 'historical & disused') -----
+ recogPar | prv cdir result features char r s t dir |
+ 
+ "Inits"				(p _ Pen new) defaultNib: 1; down.
+ 	"for points"		pts _ ReadWriteStream on: #().
+ 
+ "Event Loop"	
+ 		[Sensor anyButtonPressed] whileFalse: [(Sensor mousePoint x < 50) ifTrue: [^''].].
+ 
+ "First-Time"			pts reset.		
+ "will hold features"		ftrs _ ''.
+ 
+ 					  (Sensor anyButtonPressed) ifTrue:
+ 						[pts nextPut: (bmin _ bmax _ t _ s _ sts _ Sensor mousePoint).
+ 						p place: sts. cdir _ nil.
+ 
+ "Each-Time"		[Sensor anyButtonPressed] whileTrue:
+ 						[
+ "ink raw input"			p goto: (r _ Sensor mousePoint).
+ "smooth it"				s _ (0.5*s) + (0.5*r).
+ "thin the stream"		((s x - t x) abs > 3 or:[(s y - t y) abs > 3]) ifTrue:
+ 							[ pts nextPut: t. 
+ "bounding box"			bmin _ bmin min: s. bmax _ bmax max: s.
+ "get current dir"				dir _ (self fourDirsFrom: t to: s). t _ s.
+ 							dir ~= ' dot... ' ifTrue: [
+ "store new dirs"					cdir ~= dir ifTrue: [ftrs _ ftrs, (cdir _ dir)]].
+ "for inked t's" 			p place: t; go: 1; place: r.
+ 							].
+  "End Each-Time Loop"	].
+ 
+ "Last-Time"	
+ "start a new recog for next point"	[CharRecog new recognize] fork.
+ 
+ "save last points"		pts nextPut: t; nextPut: r.
+ "find rest of features"	features _ self extractFeatures.
+ "find char..."			char _ CharacterDictionary at: features ifAbsent:
+ "...or get from user"			[ result _ FillInTheBlank request:
+ 							 'Not recognized. type char, or type ~: ', features.
+ "ignore or..."				result = '~' ifTrue: ['']
+ "...enter new char"			ifFalse: [CharacterDictionary at: features put: result. result]].
+ 
+ "control the editor"		(char = 'cr' ifTrue: [Transcript cr] ifFalse:
+ 						[char = 'bs' ifTrue: [Transcript bs] ifFalse:
+ 						[char = 'tab' ifTrue:[Transcript tab] ifFalse:
+ 						[Transcript show: char]]]). 
+ 
+ "End First-Time Loop"	]. 
+ 
+ 
+ 
+ 			   
+  !

Item was added:
+ ----- Method: CharRecog>>recognize (in category 'historical & disused') -----
+ recognize | prv cdir result features char r s t dir |
+ 
+ "Alan Kay's recognizer as of 1/31/96.  This version preserved for historical purposes, and also because it's still called by the not-yet-deployed method recogPar.  Within the current image, the recognizer is now called via #recognizeAndDispatch:until:"
+ 
+ 
+ "Inits"				(p _ Pen new) defaultNib: 1; down.
+ 	"for points"		pts _ ReadWriteStream on: #().
+ 
+ "Event Loop"	
+ 					[(Sensor mousePoint x) < 50] whileFalse:
+ 
+ "First-Time"			[pts reset.		
+ "will hold features"		ftrs _ ''.
+ 
+ 					  (Sensor anyButtonPressed) ifTrue:
+ 						[pts nextPut: (bmin _ bmax _ t _ s _ sts _ Sensor mousePoint).
+ 						p place: sts. cdir _ nil.
+ 
+ "Each-Time"		[Sensor anyButtonPressed] whileTrue:
+ 						[
+ "ink raw input"			p goto: (r _ Sensor mousePoint).
+ "smooth it"				s _ (0.5*s) + (0.5*r).
+ "thin the stream"		((s x - t x) abs > 3 or:[(s y - t y) abs > 3]) ifTrue:
+ 							[ pts nextPut: t. 
+ "bounding box"			bmin _ bmin min: s. bmax _ bmax max: s.
+ "get current dir"				dir _ (self fourDirsFrom: t to: s). t _ s.
+ 							dir ~= ' dot... ' ifTrue: [
+ "store new dirs"					cdir ~= dir ifTrue: [ftrs _ ftrs, (cdir _ dir)]].
+ "for inked t's" 			p place: t; go: 1; place: r.
+ 							].
+  "End Each-Time Loop"	].
+ 
+ "Last-Time"	
+ 
+ "save last points"		pts nextPut: t; nextPut: r.
+ "find rest of features"	features _ self extractFeatures.
+ "find char..."			char _ CharacterDictionary at: features ifAbsent:
+ "...or get from user"			[ result _ FillInTheBlank request:
+ 							 'Not recognized. type char, or type ~: ', features.
+ "ignore or..."				result = '~' ifTrue: ['']
+ "...enter new char"			ifFalse: [CharacterDictionary at: features put: result. result]].
+ 
+ "control the editor"		(char = 'cr' ifTrue: [Transcript cr] ifFalse:
+ 						[char = 'bs' ifTrue: [Transcript bs] ifFalse:
+ 						[char = 'tab' ifTrue:[Transcript tab] ifFalse:
+ 						[Transcript show: char]]]). 
+ 
+ "End First-Time Loop"	]. 
+ 
+ "End Event-Loop" ]. 
+ 
+ 			   
+  !

Item was added:
+ ----- Method: CharRecog>>recognizeAndDispatch:ifUnrecognized:until: (in category 'recognizer') -----
+ recognizeAndDispatch: charDispatchBlock ifUnrecognized: unrecognizedFeaturesBlock until: terminationBlock
+ 	"Recognize characters, and dispatch each one found by evaluating charDispatchBlock; proceed until terminationBlock is true.  This method derives directly from Alan's 1/96 #recognize method, but factors out the character dispatch and the termination condition from the main body of the method.  2/2/96 sw.   2/5/96 sw: switch to using a class variable for the character dictionary, and don't put vacuous entries in the dictionary if the user gives an empty response to the prompt, and don't send empty characters onward, and use a variant of the FillInTheBlank that keeps the prompt clear of the working window.  8/17/96 tk: Turn cr, tab, bs into strings so they work.
+ 	 9/18/96 sw: in this variant, the block for handling unrecognized features is handed in as an argument, so that in some circumstances we can avoid putting up a prompt.  unrecognizedFeaturesBlock should be a one-argument block, which is handed in the features and which is expected to return a string which indicates the determined translation -- empty if none."
+ 
+ 	| prv cdir features char r s t dir |
+ 
+ "Inits"				(p _ Pen new) defaultNib: 1; down.
+ 	"for points"		pts _ ReadWriteStream on: #().
+ 
+ "Event Loop"	
+ 					[terminationBlock value] whileFalse:
+ 
+ "First-Time"			[pts reset.		
+ "will hold features"		ftrs _ ''.
+ 
+ 					  (Sensor anyButtonPressed) ifTrue:
+ 						[pts nextPut: (bmin _ bmax _ t _ s _ sts _ Sensor mousePoint).
+ 						p place: sts. cdir _ nil.
+ 
+ "Each-Time"		[Sensor anyButtonPressed] whileTrue:
+ "ink raw input"			[p goto: (r _ Sensor mousePoint).
+ "smooth it"				s _ (0.5*s) + (0.5*r).
+ "thin the stream"		((s x - t x) abs > 3 or:[(s y - t y) abs > 3]) ifTrue:
+ 							[pts nextPut: t. 
+ "bounding box"				bmin _ bmin min: s. bmax _ bmax max: s.
+ "get current dir"				dir _ (self fourDirsFrom: t to: s). t _ s.
+ 							dir ~= ' dot... ' ifTrue:
+ "store new dirs"					[cdir ~= dir ifTrue: [ftrs _ ftrs, (cdir _ dir)]].
+ "for inked t's" 				p place: t; go: 1; place: r]].
+  "End Each-Time Loop"
+ 
+ "Last-Time"	
+ "save last points"		pts nextPut: t; nextPut: r.
+ "find rest of features"	features _ self extractFeatures.
+ "find char..."			char _ CharacterDictionary at: features ifAbsent:
+ 							[unrecognizedFeaturesBlock value: features].
+ 
+ "special chars"		char size > 0 ifTrue:
+ 						[char = 'tab' ifTrue: [char _ Tab].
+ 						char = 'cr' ifTrue:	[char _ CR].
+ "must be a string"		char class == Character ifTrue: 
+ 							[char _ String with: char].
+ 						char = 'bs' ifTrue:	[char _ BS].
+ "control the editor"		charDispatchBlock value: char]]]
+  !

Item was added:
+ ----- Method: CharRecog>>recognizeAndDispatch:until: (in category 'recognizer') -----
+ recognizeAndDispatch: charDispatchBlock until: terminationBlock
+ 	"Recognize characters, and dispatch each one found by evaluating charDispatchBlock; proceed until terminationBlock is true. 9/18/96 sw"
+ 
+ 	^ self recognizeAndDispatch: charDispatchBlock
+ 		ifUnrecognized: 
+ 			[:features | self stringForUnrecognizedFeatures: features]
+ 		until: terminationBlock
+  !

Item was added:
+ ----- Method: CharRecog>>recognizeAndPutInTranscript (in category 'historical & disused') -----
+ recognizeAndPutInTranscript
+ 	"Call Alan's recognizer repeatedly until the mouse is near the left edge of the screen, and dispatch keystrokes inferred to the Trancript.  2/2/96 sw"
+ 
+ 	^ self recognizeAndDispatch:
+ 
+ 		[:char | (char = 'cr') ifTrue: [Transcript cr] ifFalse:
+ 						[char = 'bs' ifTrue: [Transcript bs] ifFalse:
+ 						[char = 'tab' ifTrue:[Transcript tab] ifFalse:
+ 						[Transcript show: char]]]]
+ 
+ 		until:
+ 			[Sensor mousePoint x < 50]
+ 
+ "CharRecog new recognizeAndPutInTranscript"!

Item was added:
+ ----- Method: CharRecog>>regionOf: (in category 'recognizer') -----
+ regionOf: pt 
+ 
+ | px py reg xl yl yh xr rg |
+ "it's some other character"	rg _ in/3. 	xl _ bmin x + rg x. xr _ bmax x - rg x.
+ "divide box into 9 regions"				yl _ bmin y + rg y. yh _ bmax y - rg y.
+ 
+ 					px _ pt x. py _ pt y.
+ 					reg _ (px < xl ifTrue: [py < yl ifTrue: ['NW ']
+ 										"py >= yl"	ifFalse:[ py < yh ifTrue:['W ']
+ 																	ifFalse: ['SW ']]]
+ 					ifFalse: [px < xr ifTrue: [py < yl ifTrue: ['N ']
+ 													ifFalse: [py < yh ifTrue: ['C ']
+ 																	ifFalse: ['S ']]]
+ 					ifFalse: [py < yl ifTrue: ['NE ']
+ 									ifFalse: [py < yh ifTrue: ['E ']
+ 													ifFalse: ['SE ']]]]).
+ ^reg.
+ 					!

Item was added:
+ ----- Method: CharRecog>>stringForUnrecognizedFeatures: (in category 'recognizer') -----
+ stringForUnrecognizedFeatures: features
+ 	"Prompt the user for what string the current features represent, and return the result.  9/18/96 sw"
+ 
+ 	| result |
+ 	result _ FillInTheBlank request:
+ ('Not recognized. type char, or "tab", "cr" or "bs",
+ or hit return to ignore 
+ ', features).
+ 
+ 	textMorph ifNotNil:
+ 		[textMorph world displayWorld "take down the FillInTheBlank morph"].
+ 
+ 	^ (result = '~' | result = '')
+ 		ifTrue:
+ 			['']
+ 		ifFalse:
+ 			[CharacterDictionary at: features put: result. result]!

Item was added:
+ ----- Method: CharRecog>>textMorph: (in category 'morphic dockup') -----
+ textMorph: aTextMorph
+ 	textMorph _ aTextMorph!

Item was added:
+ ----- Method: Character>>asUnicodeChar (in category '*Etoys-Squeakland-converting') -----
+ asUnicodeChar
+ 	"@@@ FIXME: Make this use asUnicode and move it to its lonely sender @@@"
+ 	| table charset v |
+ 	self leadingChar = 0 ifTrue: [^ value].
+ 	charset _ EncodedCharSet charsetAt: self leadingChar.
+ 	charset isCharset ifFalse: [^ self].
+ 	table _ charset ucsTable.
+ 	table isNil ifTrue: [^ Character value: 16rFFFD].
+ 
+ 	v _ table at: self charCode + 1.
+ 	v = -1 ifTrue: [^ Character value: 16rFFFD].
+ 
+ 	^ Character leadingChar: charset unicodeLeadingChar code: v.!

Item was added:
+ ----- Method: Character>>setValue: (in category '*Etoys-Squeakland-private') -----
+ setValue: newValue
+ 	value ifNotNil:[^self error:'Characters are immutable'].
+ 	value _ newValue.!

Item was added:
+ ----- Method: Character>>sissSequence (in category '*Etoys-Squeakland-converting') -----
+ sissSequence
+ 	"This method omits the language tags.  So, shouldn't be used for WideChars casually."
+ 	| masked s low high escapeBlock |
+ 	masked _ value bitAnd: 16r1FFFFF.
+ 	masked = 7 ifTrue: [^ '\a'].
+ 	masked = 8 ifTrue: [^ '\b'].
+ 	masked = 9 ifTrue: [^ '\t'].
+ 	masked = 10 ifTrue: [^ '\n'].
+ 	masked = 11 ifTrue: [^ '\v'].
+ 	masked = 12 ifTrue: [^ '\f'].
+ 	masked = 13 ifTrue: [^ '\r'].
+ 	masked = 27 ifTrue: [^ '\e'].
+ 	masked = 34 ifTrue: [^ '\"'].
+ 	"masked = 39 ifTrue: [^ '\''']."
+ 	masked = 92 ifTrue: [^ '\\'].
+ 
+ 	(32 <= masked and: [masked < 128]) ifTrue: [
+ 		^ self asString.
+ 	].
+ 
+ 	escapeBlock _ [:marker :digits |
+ 		s _ String new: digits + 2.
+ 		s at: 1 put: $\.
+ 		s at: 2 put: marker.
+ 		digits + 2 to: 3 by: -1 do: [:i |
+ 			s at: i put: ('0123456789ABCDEF' at: (masked \\ 16) + 1).
+ 			masked _ masked bitShift: -4
+ 		].
+ 		^ s
+ 	].
+ 
+ 	(masked < 32 or: [masked > 127 and: [masked < 256]]) ifTrue: [
+ 		escapeBlock value: $x value: 2.
+ 	].
+ 	((256 <= masked) and: [masked <= 16rFFFF]) ifTrue: [
+ 		escapeBlock value: $u value: 4.
+ 	].
+ 	low _ (masked \\ 16r400) + 16rDC00.
+ 	high _ (masked // 16r400) + 16rD800.
+ 	^ (Character value: high) sissSequence, (Character value: low) sissSequence.
+ !

Item was added:
+ ----- Method: Character>>sissUnescape (in category '*Etoys-Squeakland-converting') -----
+ sissUnescape
+ 
+ 	self = $a ifTrue: [^ Character value: 7].
+ 	self = $b ifTrue: [^ Character value: 8].
+ 	self = $t ifTrue: [^ Character value: 9].
+ 	self = $n ifTrue: [^ Character value: 10].
+ 	self = $v ifTrue: [^ Character value: 11].
+ 	self = $f ifTrue: [^ Character value: 12].
+ 	self = $r ifTrue: [^ Character value: 13].
+ 	self = $e ifTrue: [^ Character value: 27].
+ 
+ 	^ self.
+ !

Item was added:
+ Object subclass: #ChessBoard
+ 	instanceVariableNames: 'whitePlayer blackPlayer activePlayer userAgent searchAgent generator hashKey hashLock'
+ 	classVariableNames: 'HashKeys HashLocks'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games-Chess'!
+ 
+ !ChessBoard commentStamp: '<historical>' prior: 0!
+ This class represents the chess board itself.!

Item was added:
+ ----- Method: ChessBoard class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"ChessGame initialize"
+ 	self initializeHashKeys.
+ !

Item was added:
+ ----- Method: ChessBoard class>>initializeHashKeys (in category 'class initialization') -----
+ initializeHashKeys
+ 	"ChessGame initialize"
+ 	| random |
+ 	HashKeys _ Array new: 12.
+ 	1 to: HashKeys size do:[:i| HashKeys at: i put: (WordArray new: 64)].
+ 	HashLocks _ Array new: 12.
+ 	1 to: HashLocks size do:[:i| HashLocks at: i put: (WordArray new: 64)].
+ 	random _ Random seed: 23648646.
+ 	1 to: 12 do:[:i|
+ 		1 to: 64 do:[:j|
+ 			(HashKeys at: i) at: j put: (random nextInt: SmallInteger maxVal) - 1.
+ 			(HashLocks at: i) at: j put: (random nextInt: SmallInteger maxVal) - 1.
+ 		].
+ 	].
+ 
+ !

Item was added:
+ ----- Method: ChessBoard>>activePlayer (in category 'accessing') -----
+ activePlayer
+ 	^activePlayer!

Item was added:
+ ----- Method: ChessBoard>>blackPlayer (in category 'accessing') -----
+ blackPlayer
+ 	^blackPlayer!

Item was added:
+ ----- Method: ChessBoard>>copy (in category 'copying') -----
+ copy
+ 	^self shallowCopy postCopy!

Item was added:
+ ----- Method: ChessBoard>>copyBoard: (in category 'copying') -----
+ copyBoard: aBoard 
+ 	"Copy all volatile state from the given board"
+ 
+ 	whitePlayer copyPlayer: aBoard whitePlayer.
+ 	blackPlayer copyPlayer: aBoard blackPlayer.
+ 	activePlayer := aBoard activePlayer isWhitePlayer 
+ 				ifTrue: [whitePlayer]
+ 				ifFalse: [blackPlayer]. 
+ 	hashKey := aBoard hashKey.
+ 	hashLock := aBoard hashLock.
+ 	userAgent := nil!

Item was added:
+ ----- Method: ChessBoard>>generator (in category 'accessing') -----
+ generator
+ 	^generator!

Item was added:
+ ----- Method: ChessBoard>>hashKey (in category 'hashing') -----
+ hashKey
+ 	^hashKey!

Item was added:
+ ----- Method: ChessBoard>>hashLock (in category 'hashing') -----
+ hashLock
+ 	^hashLock!

Item was added:
+ ----- Method: ChessBoard>>initialize (in category 'initialize') -----
+ initialize
+ 	generator ifNil:[generator _ ChessMoveGenerator new initialize].
+ 	searchAgent ifNil:[searchAgent _ ChessPlayerAI new initialize].
+ 	self resetGame.
+ !

Item was added:
+ ----- Method: ChessBoard>>initializeNewBoard (in category 'initialize') -----
+ initializeNewBoard
+ 	self resetGame.
+ 	whitePlayer addWhitePieces.
+ 	blackPlayer addBlackPieces.
+ !

Item was added:
+ ----- Method: ChessBoard>>movePieceFrom:to: (in category 'moving') -----
+ movePieceFrom: sourceSquare to: destSquare
+ 	| move |
+ 	searchAgent isThinking ifTrue:[^self].
+ 	move _ (activePlayer findPossibleMovesAt: sourceSquare) contents
+ 		detect:[:any| any destinationSquare = destSquare].
+ 	self nextMove: move.
+ 	searchAgent activePlayer: activePlayer.!

Item was added:
+ ----- Method: ChessBoard>>nextMove: (in category 'moving') -----
+ nextMove: aMove 
+ 	activePlayer applyMove: aMove.
+ 	userAgent 
+ 		ifNotNil: [userAgent completedMove: aMove white: activePlayer isWhitePlayer].
+ 	activePlayer := activePlayer == whitePlayer 
+ 				ifTrue: [blackPlayer]
+ 				ifFalse: [whitePlayer].
+ 	activePlayer prepareNextMove !

Item was added:
+ ----- Method: ChessBoard>>nullMove (in category 'moving') -----
+ nullMove
+ 	activePlayer := activePlayer == whitePlayer 
+ 				ifTrue: [blackPlayer]
+ 				ifFalse: [whitePlayer]. 
+ 	activePlayer prepareNextMove!

Item was added:
+ ----- Method: ChessBoard>>postCopy (in category 'copying') -----
+ postCopy
+ 	whitePlayer == activePlayer ifTrue:[
+ 		whitePlayer _ whitePlayer copy.
+ 		blackPlayer _ blackPlayer copy.
+ 		activePlayer _ whitePlayer.
+ 	] ifFalse:[
+ 		whitePlayer _ whitePlayer copy.
+ 		blackPlayer _ blackPlayer copy.
+ 		activePlayer _ blackPlayer.
+ 	].
+ 	whitePlayer opponent: blackPlayer.
+ 	blackPlayer opponent: whitePlayer.
+ 	whitePlayer board: self.
+ 	blackPlayer board: self.
+ 	self userAgent: nil.!

Item was added:
+ ----- Method: ChessBoard>>printOn: (in category 'printing') -----
+ printOn: aStream
+ 	super printOn: aStream.
+ 	aStream 
+ 		nextPut: $(;
+ 		print: hashKey; space; print: hashLock;
+ 		nextPut: $).!

Item was added:
+ ----- Method: ChessBoard>>resetGame (in category 'initialize') -----
+ resetGame
+ 	hashKey _ hashLock _ 0.
+ 	whitePlayer _ ChessPlayer new initialize.
+ 	blackPlayer _ ChessPlayer new initialize.
+ 	whitePlayer opponent: blackPlayer.
+ 	whitePlayer board: self.
+ 	blackPlayer opponent: whitePlayer.
+ 	blackPlayer board: self.
+ 	activePlayer _ whitePlayer.
+ 	searchAgent reset: self.
+ 	userAgent ifNotNil:[userAgent gameReset].!

Item was added:
+ ----- Method: ChessBoard>>searchAgent (in category 'accessing') -----
+ searchAgent
+ 	^searchAgent!

Item was added:
+ ----- Method: ChessBoard>>searchAgent: (in category 'accessing') -----
+ searchAgent: anAgent
+ 	searchAgent _ anAgent.!

Item was added:
+ ----- Method: ChessBoard>>statusString (in category 'accessing') -----
+ statusString
+ 	^searchAgent statusString!

Item was added:
+ ----- Method: ChessBoard>>undoMove: (in category 'moving') -----
+ undoMove: aMove 
+ 	activePlayer := activePlayer == whitePlayer 
+ 				ifTrue: [blackPlayer]
+ 				ifFalse: [whitePlayer]. 
+ 	activePlayer undoMove: aMove.
+ 	userAgent 
+ 		ifNotNil: [userAgent undoMove: aMove white: activePlayer isWhitePlayer]!

Item was added:
+ ----- Method: ChessBoard>>updateHash:at:from: (in category 'hashing') -----
+ updateHash: piece at: square from: player 
+ 	| index |
+ 	index := player == whitePlayer ifTrue: [piece] ifFalse: [piece + 6].
+ 	hashKey := hashKey bitXor: ((HashKeys at: index) at: square). 
+ 	hashLock := hashLock bitXor: ((HashLocks at: index) at: square)!

Item was added:
+ ----- Method: ChessBoard>>userAgent (in category 'accessing') -----
+ userAgent
+ 	^userAgent!

Item was added:
+ ----- Method: ChessBoard>>userAgent: (in category 'accessing') -----
+ userAgent: anObject
+ 	userAgent _ anObject.!

Item was added:
+ ----- Method: ChessBoard>>whitePlayer (in category 'accessing') -----
+ whitePlayer
+ 	^whitePlayer!

Item was added:
+ SharedPool subclass: #ChessConstants
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'A1 A2 A3 A4 A5 A6 A7 A8 B1 B2 B3 B4 B5 B6 B7 B8 Bishop BishopMovers BishopMoves C1 C2 C3 C4 C5 C6 C7 C8 CastlingDisableAll CastlingDisableKingSide CastlingDisableQueenSide CastlingDone CastlingEnableKingSide CastlingEnableQueenSide D1 D2 D3 D4 D5 D6 D7 D8 E1 E2 E3 E4 E5 E6 E7 E8 EmptySquare F1 F2 F3 F4 F5 F6 F7 F8 G1 G2 G3 G4 G5 G6 G7 G8 H1 H2 H3 H4 H5 H6 H7 H8 King KingMoves Knight KnightMoves Pawn PieceCenterScores PieceValues Queen Rook RookMovers RookMoves'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games-Chess'!

Item was added:
+ ----- Method: ChessConstants class>>initialize (in category 'pool initialization') -----
+ initialize
+ 	"ChessConstants initialize"
+ 	self initializePieceConstants.
+ 	self initializeCastlingConstants.
+ 	self initializePieceValues.
+ 	self initializeMoves.
+ 	self initializeCenterScores.
+ 	self initializeBishopMovers.
+ 	self initializeRookMovers.
+ 	self initializeSquareConstants.!

Item was added:
+ ----- Method: ChessConstants class>>initializeBishopMovers (in category 'pool initialization') -----
+ initializeBishopMovers.
+ 	BishopMovers _ Set new.
+ 	BishopMovers add:Bishop.
+ 	BishopMovers add:Queen.!

Item was added:
+ ----- Method: ChessConstants class>>initializeBishopMoves (in category 'pool initialization') -----
+ initializeBishopMoves
+ 	"ChessPlayer initialize"
+ 	| index moveList1 moveList2 moveList3 moveList4 px py |
+ 	BishopMoves _ Array new: 64 withAll: #().
+ 	0 to: 7 do:[:j|
+ 		0 to: 7 do:[:i|
+ 			index _ (j * 8) + i + 1.
+ 			moveList1 _ moveList2 _ moveList3 _ moveList4 _ #().
+ 			1 to: 7 do:[:k|
+ 				px _ i + k. py _ j - k.
+ 				((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
+ 					moveList1 _ moveList1 copyWith: (py * 8) + px + 1].
+ 				px _ i - k. py _ j - k.
+ 				((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
+ 					moveList2 _ moveList2 copyWith: (py * 8) + px + 1].
+ 				px _ i + k. py _ j + k.
+ 				((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
+ 					moveList3 _ moveList3 copyWith: (py * 8) + px + 1].
+ 				px _ i - k. py _ j + k.
+ 				((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
+ 					moveList4 _ moveList4 copyWith: (py * 8) + px + 1].
+ 			].
+ 			BishopMoves at: index put: {moveList1. moveList2. moveList3. moveList4}.
+ 		].
+ 	].!

Item was added:
+ ----- Method: ChessConstants class>>initializeCastlingConstants (in category 'pool initialization') -----
+ initializeCastlingConstants
+ 	CastlingDone _ 1.
+ 
+ 	CastlingDisableKingSide _ 2.
+ 	CastlingDisableQueenSide _ 4.
+ 	CastlingDisableAll _ CastlingDisableQueenSide bitOr: CastlingDisableKingSide.
+ 
+ 	CastlingEnableKingSide _ CastlingDone bitOr: CastlingDisableKingSide.
+ 	CastlingEnableQueenSide _ CastlingDone bitOr: CastlingDisableQueenSide.
+ !

Item was added:
+ ----- Method: ChessConstants class>>initializeCenterScores (in category 'pool initialization') -----
+ initializeCenterScores
+ 	"ChessPlayer initialize"
+ 	PieceCenterScores _ Array new: 6.
+ 	1 to: 6 do:[:i| PieceCenterScores at: i put: (ByteArray new: 64)].
+ 	PieceCenterScores at: Knight put:
+ 		#(
+ 			-4	0	0	0	0	0	0	-4
+ 			-4	0	2	2	2	2	0	-4
+ 			-4	2	3	2	2	3	2	-4
+ 			-4	1	2	5	5	2	2	-4
+ 			-4	1	2	5	5	2	2	-4
+ 			-4	2	3	2	2	3	2	-4
+ 			-4	0	2	2	2	2	0	-4
+ 			-4	0	0	0	0	0	0	-4
+ 		).
+ 	PieceCenterScores at: Bishop put:
+ 		#(
+ 			-2	-2	-2	-2	-2	-2	-2	-2
+ 			-2	0	0	0	0	0	0	-2
+ 			-2	0	1	1	1	1	0	-2
+ 			-2	0	1	2	2	1	0	-2
+ 			-2	0	1	2	2	1	0	-2
+ 			-2	0	1	1	1	1	0	-2
+ 			-2	0	0	0	0	0	0	-2
+ 			-2	-2	-2	-2	-2	-2	-2	-2
+ 		).
+ 	PieceCenterScores at: Queen put:
+ 		#(
+ 			-3	0	0	0	0	0	0	-3
+ 			-2	0	0	0	0	0	0	-2
+ 			-2	0	1	1	1	1	0	-2
+ 			-2	0	1	2	2	1	0	-2
+ 			-2	0	1	2	2	1	0	-2
+ 			-2	0	1	1	1	1	0	-2
+ 			-2	0	0	0	0	0	0	-2
+ 			-3	0	0	0	0	0	0	-3
+ 		).!

Item was added:
+ ----- Method: ChessConstants class>>initializeKingMoves (in category 'pool initialization') -----
+ initializeKingMoves
+ 	"ChessPlayer initialize"
+ 	| index px py moveList |
+ 	KingMoves _ Array new: 64 withAll: #().
+ 	0 to: 7 do:[:j|
+ 		0 to: 7 do:[:i|
+ 			index _ (j * 8) + i + 1.
+ 			moveList _ #().
+ 			#( (-1 -1) (0 -1) (1 -1) (-1 0) (1 0) (-1 1) (0 1) (1 1)) do:[:spec|
+ 				px _ i + spec first.
+ 				py _ j + spec last.
+ 				((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
+ 					moveList _ moveList copyWith: (py * 8) + px + 1]].
+ 			KingMoves at: index put: moveList
+ 		].
+ 	].!

Item was added:
+ ----- Method: ChessConstants class>>initializeKnightMoves (in category 'pool initialization') -----
+ initializeKnightMoves
+ 	"ChessPlayer initialize"
+ 	| index px py moveList |
+ 	KnightMoves _ Array new: 64 withAll: #().
+ 	0 to: 7 do:[:j|
+ 		0 to: 7 do:[:i|
+ 			index _ (j * 8) + i + 1.
+ 			moveList _ #().
+ 			#( (-2 -1) (-1 -2) (1 -2) (2 -1) (-2 1) (-1 2) (1 2) (2 1)) do:[:spec|
+ 				px _ i + spec first.
+ 				py _ j + spec last.
+ 				((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
+ 					moveList _ moveList copyWith: (py * 8) + px + 1]].
+ 			KnightMoves at: index put: moveList
+ 		].
+ 	].!

Item was added:
+ ----- Method: ChessConstants class>>initializeMoves (in category 'pool initialization') -----
+ initializeMoves
+ 	"ChessPlayer initialize"
+ 	self initializeKnightMoves.
+ 	self initializeRookMoves.
+ 	self initializeBishopMoves.
+ 	self initializeKingMoves.!

Item was added:
+ ----- Method: ChessConstants class>>initializePieceConstants (in category 'pool initialization') -----
+ initializePieceConstants
+ 	EmptySquare := 0.
+ 	Pawn := 1.
+ 	Knight := 2.
+ 	Bishop := 3.
+ 	Rook := 4.
+ 	Queen := 5.
+ 	King := 6.!

Item was added:
+ ----- Method: ChessConstants class>>initializePieceValues (in category 'pool initialization') -----
+ initializePieceValues
+ 	PieceValues _ Array new: 6.
+ 	PieceValues at: Pawn put: 100.
+ 	PieceValues at: Knight put: 300.
+ 	PieceValues at: Bishop put: 350.
+ 	PieceValues at: Rook put: 500.
+ 	PieceValues at: Queen put: 900.
+ 	PieceValues at: King put: 2000.
+ !

Item was added:
+ ----- Method: ChessConstants class>>initializeRookMovers (in category 'pool initialization') -----
+ initializeRookMovers.
+ 	RookMovers _ Set new.
+ 	RookMovers add:Rook.
+ 	RookMovers add:Queen.!

Item was added:
+ ----- Method: ChessConstants class>>initializeRookMoves (in category 'pool initialization') -----
+ initializeRookMoves
+ 	"ChessPlayer initialize"
+ 	| index moveList1 moveList2 moveList3 moveList4 px py |
+ 	RookMoves _ Array new: 64 withAll: #().
+ 	0 to: 7 do:[:j|
+ 		0 to: 7 do:[:i|
+ 			index _ (j * 8) + i + 1.
+ 			moveList1 _ moveList2 _ moveList3 _ moveList4 _ #().
+ 			1 to: 7 do:[:k|
+ 				px _ i + k. py _ j.
+ 				((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
+ 					moveList1 _ moveList1 copyWith: (py * 8) + px + 1].
+ 				px _ i. py _ j + k.
+ 				((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
+ 					moveList2 _ moveList2 copyWith: (py * 8) + px + 1].
+ 				px _ i - k. py _ j.
+ 				((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
+ 					moveList3 _ moveList3 copyWith: (py * 8) + px + 1].
+ 				px _ i. py _ j - k.
+ 				((px between: 0 and: 7) and:[py between: 0 and: 7]) ifTrue:[
+ 					moveList4 _ moveList4 copyWith: (py * 8) + px + 1].
+ 			].
+ 			RookMoves at: index put: {moveList1. moveList2. moveList3. moveList4}.
+ 		].
+ 	].!

Item was added:
+ ----- Method: ChessConstants class>>initializeSquareConstants (in category 'pool initialization') -----
+ initializeSquareConstants
+ 	A1_1. B1_2. C1_3. D1_4. E1_5. F1_6. G1_7. H1_8.
+ 	A2_9. B2_10. C2_11. D2_12. E2_13. F2_14. G2_15. H2_16.
+ 	A3_17. B3_18. C3_19. D3_20. E3_21. F3_22. G3_23. H3_24.
+ 	A4_25. B4_26. C4_27. D4_28. E4_29. F4_30. G4_31. H4_32.
+ 	A5_33. B5_34. C5_35. D5_36. E5_37. F5_38. G5_39. H5_40.
+ 	A6_41. B6_42. C6_43. D6_44. E6_45. F6_46. G6_47. H6_48.
+ 	A7_49. B7_50. C7_51. D7_52. E7_53. F7_54. G7_55. H7_56.
+ 	A8_57. B8_58. C8_59. D8_60. E8_61. F8_62. G8_63. H8_64.!

Item was added:
+ Object variableWordSubclass: #ChessHistoryTable
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games-Chess'!
+ 
+ !ChessHistoryTable commentStamp: '<historical>' prior: 0!
+ This class is a history table for our 'killer heuristic'. It remembers moves that have proven effective in the past and is later used to prioritize newly generated moves according to the effectiveness of the particular move in the past.!

Item was added:
+ ----- Method: ChessHistoryTable class>>new (in category 'instance creation') -----
+ new
+ 	^self new: 4096+64!

Item was added:
+ ----- Method: ChessHistoryTable>>addMove: (in category 'accessing') -----
+ addMove: aMove
+ 	| index |
+ 	index _ (aMove sourceSquare bitShift: 6) + aMove destinationSquare.
+ 	self at: index put: (self at: index + 1)!

Item was added:
+ ----- Method: ChessHistoryTable>>atAllPut: (in category 'initialize') -----
+ atAllPut: aPositiveInteger
+ 	"Fill the receiver, an indexable bytes or words object, with the given positive integer. The range of possible fill values is [0..255] for byte arrays and [0..(2^32 - 1)] for word arrays."
+ 
+ 	<primitive: 145>
+ 	self errorImproperStore.!

Item was added:
+ ----- Method: ChessHistoryTable>>clear (in category 'initialize') -----
+ clear
+ 	self atAllPut: 0.!

Item was added:
+ ----- Method: ChessHistoryTable>>sorts:before: (in category 'sorting') -----
+ sorts: move1 before: move2
+ 	^(self at: (move1 sourceSquare bitShift: 6) + move1 destinationSquare) >
+ 		(self at: (move2 sourceSquare bitShift: 6) + move2 destinationSquare)!

Item was added:
+ BorderedMorph subclass: #ChessMorph
+ 	instanceVariableNames: 'board history redoList animateMove autoPlay'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games-Chess'!
+ 
+ !ChessMorph commentStamp: '<historical>' prior: 0!
+ This class defines the user interface for a fine game of chess.!

Item was added:
+ ----- Method: ChessMorph class>>blackBishopImage (in category 'accessing') -----
+ blackBishopImage
+ 	^((ColorForm
+ 	extent: 40 at 40
+ 	depth: 2
+ 	fromArray: #( 0 0 0 0 0 0 0 21053440 0 0 21053440 0 0 4538368 0 0 88489984 0 0 357978112 0 0 357994496 0 0 1431675904 0 1 1452647424 0 1 1452631040 0 5 1789487360 0 5 1789483264 0 5 1452628224 0 21 1452627200 0 21 1452626944 0 21 1431655424 0 21 1431655424 0 21 1431655424 0 21 1431654400 0 21 1431654400 0 5 1431654400 0 5 1431650304 0 1 1431650304 0 1 2863284224 0 1 2863284224 0 0 1431633920 0 0 445644800 0 1 1431650304 0 1 1789476864 0 1 1789476864 0 1 1431650304 0 0 20971520 0 0 89128960 0 0 357826560 0 21840 1414858069 0 349525 1410684245 1342177280 344085 1074091009 1342177280 262144 0 268435456 0 0 0)
+ 	offset: 0 at 0)
+ 	colorsFromArray: #(#( ) #(0.0 0.0 0.032) #(1.0 1.0 1.0) #( )  ))!

Item was added:
+ ----- Method: ChessMorph class>>blackKingImage (in category 'accessing') -----
+ blackKingImage
+ 	^((ColorForm
+ 	extent: 40 at 40
+ 	depth: 2
+ 	fromArray: #( 0 0 0 0 0 0 0 0 0 0 4194304 0 0 22020096 0 0 4194304 0 0 89391104 0 0 111411200 0 1398016 107216981 1426063360 22369600 107218261 1430257664 22456660 107222362 2772434944 89740885 111416741 1498415104 90527125 1162892885 1448083456 93672805 1095850325 1448083456 362108249 1431656790 2522087424 362190169 1435854230 2522087424 362190422 1452643686 2522087424 362112598 1431672169 1448345600 362112597 2505463146 2522087424 93760085 2505463145 1448083456 93678165 2526434665 1448083456 93673045 1704351141 1498415104 90527317 1700353429 1498415104 23418261 1700353429 1497366528 22631829 1499027029 1497366528 22631829 1503221333 1698693120 5657957 1503222101 1694498816 1463653 1499026773 2483027968 1414485 1499026774 1409286144 354986 2841291433 1342177280 87381 1431655765 1073741824 21845 1431655765 0 5802 2863311508 0 6485 1431655780 0 6485 1521046884 0 6485 1431655780 0 6826 2863311524 0 5461 1431655764 0 0 0 0 0 0 0)
+ 	offset: 0 at 0)
+ 	colorsFromArray: #(#( ) #(0.0 0.0 0.032) #(1.0 1.0 1.0) #( )  ))!

Item was added:
+ ----- Method: ChessMorph class>>blackKnightImage (in category 'accessing') -----
+ blackKnightImage
+ 	^((ColorForm
+ 	extent: 40 at 40
+ 	depth: 2
+ 	fromArray: #( 0 0 0 0 0 0 0 268435456 0 1 335544320 0 1 335544320 0 1 1430257664 0 0 1431568384 0 1 1431650304 0 21 1432704000 0 342 2774160704 0 1370 1767216464 0 5461 2505402708 0 21845 1431656021 0 87381 1431655829 0 349525 1431655781 1073741824 1398101 1431672149 1342177280 1398101 1431672153 1342177280 5592405 1431983446 1409286144 5592405 1343576406 1409286144 22369600 1402197 2483027968 26543360 5920085 2768240640 22287360 5593685 1694498816 22040576 23766357 1694498816 81920 89478485 1698693120 0 89478485 1698693120 0 357913941 1765801984 0 1431655765 1765801984 0 1431655765 1766850560 1 1431655765 1498415104 5 1431655765 1498415104 21 1431655765 1498415104 21 1431655765 1498415104 21 1431655765 1498415104 85 1431655765 1498415104 341 1431655765 1498415104 341 1431655765 1498415104 1365 1431655765 1498415104 1365 1431655765 1431306240 1365 1431655765 1431306240 0 0 0)
+ 	offset: 0 at 0)
+ 	colorsFromArray: #(#( ) #(0.0 0.0 0.032) #(1.0 1.0 1.0) #( )  ))!

Item was added:
+ ----- Method: ChessMorph class>>blackPawnImage (in category 'accessing') -----
+ blackPawnImage
+ 	^((ColorForm
+ 	extent: 40 at 40
+ 	depth: 1
+ 	fromArray: #( 0 0 15360 0 32256 0 32256 0 32256 0 32256 0 32256 0 15360 0 65280 0 262080 0 65280 0 32256 0 32256 0 65280 0 65280 0 65280 0 130944 0 262080 0 262080 0 524256 0 524256 0 524256 0 524256 0 524256 0 524256 0 524256 0 262080 0 262080 0 262080 0 130944 0 65280 0 65280 0 524256 0 4194300 0 8388606 0 16777215 0 33554431 2147483648 33554431 2147483648 33554431 2147483648 0 0)
+ 	offset: 0 at 0)
+ 	colorsFromArray: #(#( ) #(0.0 0.0 0.032)  ))!

Item was added:
+ ----- Method: ChessMorph class>>blackQueenImage (in category 'accessing') -----
+ blackQueenImage
+ 	^((ColorForm
+ 	extent: 40 at 40
+ 	depth: 2
+ 	fromArray: #( 0 0 0 0 0 0 0 0 0 0 5242880 0 0 5242880 0 0 1048576 0 320 4194324 0 320 5242900 0 64 5242896 0 64 5242896 0 64 5242896 0 80 5242960 0 83886160 5242960 0 83886160 5242960 1310720 16777300 5243216 1310720 4194388 22282576 1048576 4194388 22282576 4194304 5242964 22282576 4194304 5505109 22283600 20971520 1310805 22283600 88080384 1376341 22283600 88080384 1392725 1096029520 356515840 1392725 1096029520 356515840 1396821 1096029520 1430257664 1397845 1431655761 1426063360 349269 1431655761 1426063360 349525 1431655765 1426063360 349525 1431655765 1426063360 349525 1431655765 1426063360 349525 1521112405 1426063360 88746 2773854890 1409286144 91477 1453938005 2483027968 27285 1436898666 2415919104 23125 1521112410 1342177280 6826 2773854890 1073741824 5461 1431655765 1073741824 21845 1431655765 1342177280 21845 1431655765 1342177280 0 0 0 0 0 0)
+ 	offset: 0 at 0)
+ 	colorsFromArray: #(#( ) #(0.0 0.0 0.032) #(1.0 1.0 1.0) #( )  ))!

Item was added:
+ ----- Method: ChessMorph class>>blackRookImage (in category 'accessing') -----
+ blackRookImage
+ 	^((ColorForm
+ 	extent: 40 at 40
+ 	depth: 2
+ 	fromArray: #( 0 0 0 0 357826560 0 349184 357826645 1073741824 349184 357826645 1073741824 349184 357826645 1073741824 349525 1431655765 1073741824 436906 2863311530 1073741824 349526 1431721301 1073741824 1366 1431721296 0 1366 1431721296 0 1366 1431721296 0 1366 1431721296 0 1366 1431721296 0 1706 2863311504 0 1365 1448432976 0 1365 1448432976 0 1365 1448432976 0 1365 1448432976 0 1365 1448432976 0 1706 2863311504 0 1366 1431721296 0 1366 1431721296 0 1366 1431721296 0 1366 1431721296 0 1366 1431721296 0 1706 2863311504 0 1365 1448432976 0 1365 1448432976 0 1365 1448432976 0 1365 1448432976 0 1365 1448432976 0 1365 1448432976 0 1706 2863311504 0 23210 2863311525 0 27306 2863311529 0 87381 1431655765 1073741824 436906 2863311530 2415919104 436906 2863311530 2415919104 349525 1431655765 1342177280 0 0 0)
+ 	offset: 0 at 0)
+ 	colorsFromArray: #(#( ) #(0.0 0.0 0.032) #(1.0 1.0 1.0) #( )  ))!

Item was added:
+ ----- Method: ChessMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName: 	'Chess' translatedNoop
+ 		categories:		{'Games' translatedNoop}
+ 		documentation:	'A fine game of chess' translatedNoop!

Item was added:
+ ----- Method: ChessMorph class>>whiteBishopImage (in category 'accessing') -----
+ whiteBishopImage
+ 	^((ColorForm
+ 	extent: 40 at 40
+ 	depth: 2
+ 	fromArray: #( 0 0 0 0 0 0 0 16842752 0 0 88424448 0 0 88424448 0 0 89473024 0 0 378966016 0 0 1520865280 0 1 1789240320 0 1 2842256384 0 5 2842321920 0 6 2505462784 0 22 2505479168 0 26 2842338304 0 26 2842338304 0 26 2842338304 0 26 2863309824 0 26 2863309824 0 26 2863309824 0 26 2863309824 0 26 2863305728 0 22 2863304704 0 6 2863288320 0 5 2863284224 0 1 1431650304 0 1 1431650304 0 1 1768505344 0 1 1768505344 0 1 1768505344 0 1 1431650304 0 5 2863284224 0 5 1431654400 0 0 104857600 0 0 374341632 0 0 1498677248 0 87381 1701139797 1073741824 1419946 2488969898 1409286144 349525 1343575381 1342177280 1310720 0 335544320 0 0 0)
+ 	offset: 0 at 0)
+ 	colorsFromArray: #(#( ) #(0.0 0.0 0.032) #(1.0 1.0 1.0) #( )  ))!

Item was added:
+ ----- Method: ChessMorph class>>whiteKingImage (in category 'accessing') -----
+ whiteKingImage
+ 	^((ColorForm
+ 	extent: 40 at 40
+ 	depth: 2
+ 	fromArray: #( 0 0 0 0 0 0 0 22020096 0 0 93585408 0 0 111411200 0 0 93585408 0 0 362020864 0 1397760 447021077 1409286144 5940480 425263450 2768240640 23767376 429458858 2839543808 94721684 425268885 1448083456 110536037 426072410 2794455040 379234921 1499818410 2777939968 442149466 1431676586 2846097408 443198102 2526451305 1772355584 443116133 2842319449 1772355584 443111785 2841270937 2846097408 443193769 1785293465 2577661952 442866090 1789504149 1503920128 443110826 1785309845 2846097408 376083882 1499048598 2845048832 106603946 2573838938 2777677824 110799274 2594548330 2794455040 110799210 2594613610 2794455040 93760106 2523310506 2521825280 27699802 2774968746 2587885568 23440026 2795939242 1497366528 6908570 2795939497 1694498816 5925546 2795940521 2751463424 1463637 1453675861 2483027968 371301 2506447274 1342177280 87641 2590415189 1073741824 26261 1431655845 0 21850 2774182229 0 21930 2505484885 0 21866 2842339669 0 22165 1431655829 0 21850 2863311189 0 21845 1431655765 0 0 0 0)
+ 	offset: 0 at 0)
+ 	colorsFromArray: #(#( ) #(0.0 0.0 0.032) #(1.0 1.0 1.0) #( )  ))!

Item was added:
+ ----- Method: ChessMorph class>>whiteKnightImage (in category 'accessing') -----
+ whiteKnightImage
+ 	^((ColorForm
+ 	extent: 40 at 40
+ 	depth: 2
+ 	fromArray: #( 0 0 0 0 1073741824 0 16 1342177280 0 20 1342177280 0 5 1430257664 0 6 2857713664 0 6 2862956544 0 22 2863223808 0 346 2863306048 0 1445 1789569360 0 22166 1521134164 0 91813 1789569685 0 367274 2863245989 1073741824 1469098 2862983845 1342177280 1682090 2863049385 1342177280 5679786 2863048362 1409286144 22718890 2861996714 1409286144 27961706 2775210410 2499805184 95070809 1432708522 2499805184 111503701 22455978 2503999488 378889472 27957930 2773483520 374969344 94988970 2773483520 88428544 106343082 2773483520 84295680 359312042 2840592384 344064 1521134250 2840592384 1 1789569706 2840592384 1 2863311530 2840854528 5 2863311530 2857631744 22 2863311530 2857631744 26 2863311530 2857631744 90 2863311530 2857631744 106 2863311530 2857631744 362 2863311530 2857631744 1450 2863311530 2857631744 1706 2863311530 2857631744 5802 2863311530 2857631744 6826 2863311530 2857631744 23210 2863311530 2857631744 21845 1431655765 1431568384 0 0 0)
+ 	offset: 0 at 0)
+ 	colorsFromArray: #(#( ) #(0.0 0.0 0.032) #(1.0 1.0 1.0) #( )  ))!

Item was added:
+ ----- Method: ChessMorph class>>whitePawnImage (in category 'accessing') -----
+ whitePawnImage
+ 	^((ColorForm
+ 	extent: 40 at 40
+ 	depth: 2
+ 	fromArray: #( 0 0 0 0 357826560 0 0 446955520 0 0 1520762880 0 0 1789460480 0 0 1520762880 0 0 378798080 0 0 1431633920 0 1 1789476864 0 21 2863289344 0 85 1431655680 0 0 446955520 0 0 1520762880 0 0 1789460480 0 0 1789460480 0 1 1789476864 0 5 2863288320 0 6 2863304704 0 22 2863305728 0 26 2863309824 0 90 2863310080 0 106 2863311104 0 106 2863311104 0 106 2863311104 0 90 2863310080 0 26 2863309824 0 26 2863309824 0 22 2863305728 0 6 2863304704 0 5 2863288320 0 1 1789476864 0 0 1789460480 0 341 1520784704 0 1450 2505484880 0 22186 2863311509 0 92842 2863311529 1073741824 109226 2863311530 1073741824 109226 2863311530 1073741824 87381 1431655765 1073741824 0 0 0)
+ 	offset: 0 at 0)
+ 	colorsFromArray: #(#( ) #(0.0 0.0 0.032) #(1.0 1.0 1.0) #( )  ))!

Item was added:
+ ----- Method: ChessMorph class>>whiteQueenImage (in category 'accessing') -----
+ whiteQueenImage
+ 	^((ColorForm
+ 	extent: 40 at 40
+ 	depth: 2
+ 	fromArray: #( 0 0 0 0 0 0 0 5242880 0 0 22282240 0 0 5242880 0 64 5242896 0 336 5242964 0 336 5242964 0 64 5242896 0 64 5242896 0 80 5242960 0 80 22282320 0 83886160 27525200 1310720 352321620 27525456 1376256 88080484 27525520 1376256 20971620 27525520 5242880 5242981 27526544 5242880 5505129 27526800 22020096 6553705 27526800 93323264 6619241 1101272720 105906176 6881386 1168448144 373293056 5849194 1185487504 440401920 1724522 1453939344 1514143744 1740906 2527685265 1782579200 1741930 2527685265 2856321024 1746282 2863311509 2856321024 1747306 2863311510 2856321024 1485482 2863311530 2839543808 436906 2863311530 2835349504 436906 2505403050 2835349504 365909 1515869525 1694498816 87466 2773854885 1409286144 21850 2841029205 1342177280 21866 2505403029 1342177280 21845 1521112405 1342177280 27306 2863311530 2415919104 27306 2863311530 2415919104 92842 2863311530 2483027968 87381 1431655765 1409286144 0 0 0)
+ 	offset: 0 at 0)
+ 	colorsFromArray: #(#( ) #(0.0 0.0 0.032) #(1.0 1.0 1.0) #( )  ))!

Item was added:
+ ----- Method: ChessMorph class>>whiteRookImage (in category 'accessing') -----
+ whiteRookImage
+ 	^((ColorForm
+ 	extent: 40 at 40
+ 	depth: 2
+ 	fromArray: #( 0 0 0 0 357892096 0 87360 447283221 1409286144 109120 447283226 2751463424 109120 447283226 2751463424 109141 1521046874 2751463424 109226 2863311530 2751463424 87381 1431655765 1409286144 426 1789553316 0 426 1789553316 0 426 1789553316 0 426 1789553316 0 426 1789553316 0 341 1431655764 0 426 2859117220 0 426 2859117220 0 426 2859117220 0 426 2859117220 0 426 2859117220 0 341 1431655764 0 426 1789553316 0 426 1789553316 0 426 1789553316 0 426 1789553316 0 426 1789553316 0 341 1431655764 0 426 2859117220 0 426 2859117220 0 426 2859117220 0 426 2859117220 0 426 2859117220 0 426 2859117220 0 5461 1431655765 0 23210 2863311529 1073741824 27306 2863311530 1073741824 87381 1431655765 1342177280 371370 2863311530 2483027968 436906 2863311530 2751463424 349525 1431655765 1409286144 0 0 0)
+ 	offset: 0 at 0)
+ 	colorsFromArray: #(#( ) #(0.0 0.0 0.032) #(1.0 1.0 1.0) #( )  ))!

Item was added:
+ ----- Method: ChessMorph>>acceptDroppingMorph:event: (in category 'layout') -----
+ acceptDroppingMorph: aMorph event: anEvent
+ 	| destSquare sourceSquare |
+ 	sourceSquare _ aMorph valueOfProperty: #chessBoardSourceSquare.
+ 	aMorph removeProperty: #chessBoardSourceSquare.
+ 	destSquare _ self asSquare: aMorph center.
+ 	"!!!!!! ACTUAL MOVE HAPPENS INDIRECTLY !!!!!!"
+ 	(self atSquare: sourceSquare) addMorphCentered: aMorph.
+ 	destSquare ifNil:[^self].
+ 	self movePieceFrom: sourceSquare to: destSquare.
+ 	self showMovesAt: destSquare.!

Item was added:
+ ----- Method: ChessMorph>>addButtonRow (in category 'initialize') -----
+ addButtonRow
+ 
+ 	| r m |
+ 	r _ AlignmentMorph newRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; color: Color transparent.
+ 	r addMorphBack: (self buttonName: '  New  ' translated action: #newGame).
+ 	r addMorphBack: (self buttonName: '  Help  ' translated action: #findBestMove).
+ 	r addMorphBack: (self buttonName: '  Play  ' translated action: #thinkAndMove).
+ 	r addMorphBack: (self buttonName: '  Auto  ' translated action: #autoPlay).
+ 	r addMorphBack: (self buttonName: '  Undo  ' translated action: #undoMove).
+ 	r addMorphBack: (self buttonName: '  Redo  ' translated action: #redoMove).
+ 	r addMorphBack: (self buttonName: '  Quit  ' translated action: #delete).
+ 	r disableTableLayout: true.
+ 	r align: r bounds topLeft with: self layoutBounds topLeft.
+ 	self addMorphFront: r.
+ 	m _ UpdatingStringMorph on: self selector: #statusString.
+ 	m useStringFormat.
+ 	m disableTableLayout: true.
+ 	m align: m bounds topLeft with: r fullBounds bottomLeft.
+ 	self addMorphFront: m.!

Item was added:
+ ----- Method: ChessMorph>>addSquares (in category 'initialize') -----
+ addSquares
+ 	| white black square index |
+ 	white _ Color white.
+ 	black _ Color lightGray.
+ 	index _ 0.
+ 	#(
+ 		(	' '	'a'	'b'	'c'	'd'	'e'	'f'	'g'	'h'	' ')
+ 		(	'1'	'B'	'W'	'B'	'W'	'B'	'W'	'B'	'W'	' ')
+ 		(	'2'	'W'	'B'	'W'	'B'	'W'	'B'	'W'	'B'	' ')
+ 		(	'3'	'B'	'W'	'B'	'W'	'B'	'W'	'B'	'W'	' ')
+ 		(	'4'	'W'	'B'	'W'	'B'	'W'	'B'	'W'	'B'	' ')
+ 		(	'5'	'B'	'W'	'B'	'W'	'B'	'W'	'B'	'W'	' ')
+ 		(	'6'	'W'	'B'	'W'	'B'	'W'	'B'	'W'	'B'	' ')
+ 		(	'7'	'B'	'W'	'B'	'W'	'B'	'W'	'B'	'W'	' ')
+ 		(	'8'	'W'	'B'	'W'	'B'	'W'	'B'	'W'	'B'	' ')
+ 		(	' '	' '	' '	' '	' '	' '	' '	' '	' '	' ')
+ 	) do:[:file|
+ 		file do:[:sq|
+ 		square _ self newSquare.
+ 		square borderWidth: 0.
+ 		(sq = 'W' or:[sq = 'B']) ifTrue:[
+ 			square color: (sq = 'W' ifTrue:[white] ifFalse:[black]).
+ 			square borderColor: Color red.
+ 			square setProperty: #squarePosition toValue: (index _ index + 1).
+ 			square setNameTo: 
+ 				(String with: ($a asInteger + (index - 1 bitAnd: 7)) asCharacter with: ($1 asInteger + (index -1 bitShift: -3)) asCharacter).
+ 			square on: #mouseEnter send: #showMoves:from: to: self.
+ 			square on: #mouseEnterDragging send: #dragSquareEnter:from: to: self.
+ 			square on: #mouseLeaveDragging send: #dragSquareLeave:from: to: self.
+ 		] ifFalse:["decoration"
+ 			square color: Color transparent.
+ 			sq = ' ' ifFalse:[
+ 				square addMorphCentered: (StringMorph contents: sq asUppercase font: Preferences windowTitleFont emphasis: 1).
+ 			].
+ 		].
+ 		square extent: 40 at 40.
+ 		self addMorphBack: square.
+ 	]].
+ !

Item was added:
+ ----- Method: ChessMorph>>addedPiece:at:white: (in category 'game callbacks') -----
+ addedPiece: piece at: square white: isWhite
+ 	| m |
+ 	m _ self newPiece: piece white: isWhite.
+ 	m on: #mouseDown send: #dragPiece:from: to: self.
+ 	m setProperty: #chessBoard toValue: self.
+ 	(self atSquare: square) removeAllMorphs; addMorphCentered: m.!

Item was added:
+ ----- Method: ChessMorph>>areasRemainingToFill: (in category 'drawing') -----
+ areasRemainingToFill: x
+ 	^x areasOutside: self bounds!

Item was added:
+ ----- Method: ChessMorph>>asSquare: (in category 'geometry') -----
+ asSquare: aPoint
+ 	self squaresDo:[:sq| (sq bounds containsPoint: aPoint) ifTrue:[^sq valueOfProperty: #squarePosition]].
+ 	^nil!

Item was added:
+ ----- Method: ChessMorph>>atSquare: (in category 'geometry') -----
+ atSquare: square
+ 	^submorphs detect:[:any| (any valueOfProperty: #squarePosition) = square] ifNone:[nil]!

Item was added:
+ ----- Method: ChessMorph>>autoPlay (in category 'playing') -----
+ autoPlay
+ 	autoPlay _ autoPlay not.
+ 	autoPlay ifTrue:[self thinkAndMove].!

Item was added:
+ ----- Method: ChessMorph>>buttonFillStyle (in category 'initialize') -----
+ buttonFillStyle
+ 
+ 	| fill |
+ 	fill _ GradientFillStyle ramp: {
+ 		0.0 -> (Color r: 0.05 g: 0.5 b: 1.0). 
+ 		1.0 -> (Color r: 0.85 g: 0.95 b: 1.0)}.
+ 	fill origin: (0 at 0).
+ 	fill direction: 40 at 10.
+ 	fill radial: false.
+ 	^ fill
+ !

Item was added:
+ ----- Method: ChessMorph>>buttonName:action: (in category 'initialize') -----
+ buttonName: aString action: aSymbol
+ 
+ 	^ SimpleButtonMorph new
+ 		target: self;
+ 		label: aString;
+ 		actionSelector: aSymbol;
+ 		color: (Color gray: 0.8);  "old color"
+ 		fillStyle: self buttonFillStyle;
+ 		borderWidth: 0;
+ 		borderColor: #raised.
+ !

Item was added:
+ ----- Method: ChessMorph>>completedMove:white: (in category 'game callbacks') -----
+ completedMove: aMove white: aBool
+ 	board ifNil:[^self].
+ 	history addLast: aMove.
+ 	self validateGamePosition.!

Item was added:
+ ----- Method: ChessMorph>>defaultBorderColor (in category 'initialization') -----
+ defaultBorderColor
+ "answer the default border color/fill style for the receiver"
+ 	^ #raised!

Item was added:
+ ----- Method: ChessMorph>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ "answer the default border width for the receiver"
+ 	^ 5!

Item was added:
+ ----- Method: ChessMorph>>defaultBounds (in category 'initialization') -----
+ defaultBounds
+ 	"answer the default bounds for the receiver"
+ 	^ 0 @ 0 corner: 410 @ 410!

Item was added:
+ ----- Method: ChessMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the receiver's default color"
+ 	| result |
+ 	result _ GradientFillStyle ramp: {0.0
+ 					-> (Color
+ 							r: 0.05
+ 							g: 0.5
+ 							b: 1.0). 1.0
+ 					-> (Color
+ 							r: 0.85
+ 							g: 0.95
+ 							b: 1.0)}.
+ 	result origin: self bounds origin;
+ 		 direction: self extent.
+ 	result radial: false.
+ 	^ result!

Item was added:
+ ----- Method: ChessMorph>>dragPiece:from: (in category 'drag and drop') -----
+ dragPiece: evt from: aMorph
+ 	board searchAgent isThinking ifTrue:[^self].
+ 	self submorphsDo:[:m| m borderWidth: 0].
+ 	aMorph setProperty: #chessBoardSourceSquare toValue: (aMorph owner valueOfProperty: #squarePosition).
+ 	evt hand grabMorph: aMorph.!

Item was added:
+ ----- Method: ChessMorph>>dragSquareEnter:from: (in category 'drag and drop') -----
+ dragSquareEnter: evt from: aMorph
+ 	"Note: #wantsDroppedMorph: will validate move"
+ 	board ifNil:[^self].
+ 	evt hand hasSubmorphs ifFalse:[^self].
+ 	(self wantsDroppedMorph: evt hand firstSubmorph event: evt) ifFalse:[^self].
+ 	aMorph borderWidth: 1.!

Item was added:
+ ----- Method: ChessMorph>>dragSquareLeave:from: (in category 'drag and drop') -----
+ dragSquareLeave: evt from: aMorph
+ 	board ifNil:[^self].
+ 	evt hand hasSubmorphs ifFalse:[^self].
+ 	aMorph borderWidth: 0.!

Item was added:
+ ----- Method: ChessMorph>>findBestMove (in category 'playing') -----
+ findBestMove
+ 	| move |
+ 	board searchAgent isThinking ifTrue:[^self].
+ 	Cursor wait showWhile:[move _ board searchAgent think].
+ 	self inform: 'I suggest: ' translated, move printString.
+ 	^move!

Item was added:
+ ----- Method: ChessMorph>>finishedGame: (in category 'game callbacks') -----
+ finishedGame: result
+ 	"
+ 		0 - white lost
+ 		0.5 - draw
+ 		1 - white won
+ 	"
+ 	board _ nil.!

Item was added:
+ ----- Method: ChessMorph>>gameReset (in category 'game callbacks') -----
+ gameReset
+ 	self squaresDo:[:m| m removeAllMorphs; borderWidth: 0]!

Item was added:
+ ----- Method: ChessMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	animateMove _ false.
+ 	autoPlay _ false.
+ 
+ 	self cornerStyle: #rounded.
+ 	self layoutPolicy: TableLayout new.
+ 	self listDirection: #leftToRight;
+ 		 wrapDirection: #bottomToTop.
+ 	self addSquares.
+ 	self addButtonRow.
+ 	self newGame!

Item was added:
+ ----- Method: ChessMorph>>movePieceFrom:to: (in category 'playing') -----
+ movePieceFrom: sourceSquare to: destSquare
+ 	board ifNil:[^self].
+ 	board searchAgent isThinking ifTrue:[^self].
+ 	board movePieceFrom: sourceSquare to: destSquare.
+ 	board searchAgent startThinking.!

Item was added:
+ ----- Method: ChessMorph>>movedPiece:from:to: (in category 'game callbacks') -----
+ movedPiece: piece from: sourceSquare to: destSquare
+ 	| sourceMorph destMorph sourcePos destPos w startTime nowTime deltaTime |
+ 	sourceMorph _ (self atSquare: sourceSquare) firstSubmorph.
+ 	destMorph _ self atSquare: destSquare.
+ 	animateMove ifTrue:[
+ 		sourcePos _ sourceMorph boundsInWorld center.
+ 		destPos _ destMorph boundsInWorld center.
+ 		(w _ self world) ifNotNil:[
+ 			w addMorphFront: sourceMorph.
+ 			sourceMorph addDropShadow.
+ 			sourceMorph shadowColor: (Color black alpha: 0.5).
+ 			deltaTime _ (sourcePos dist: destPos) * 10 asInteger.
+ 			startTime _ Time millisecondClockValue.
+ 			[nowTime _ Time millisecondClockValue.
+ 			nowTime - startTime < deltaTime] whileTrue:[
+ 				sourceMorph center: sourcePos + (destPos - sourcePos * (nowTime - startTime) // deltaTime) asIntegerPoint.
+ 				w displayWorldSafely].
+ 			sourceMorph removeDropShadow.
+ 		].
+ 	].
+ 	destMorph removeAllMorphs.
+ 	destMorph addMorphCentered: sourceMorph.
+ 	animateMove _ false.!

Item was added:
+ ----- Method: ChessMorph>>newGame (in category 'playing') -----
+ newGame
+ 	board ifNil:[board _ ChessBoard new].
+ 	board initialize.
+ 	board userAgent: self.
+ 	board initializeNewBoard.
+ 	history _ OrderedCollection new.
+ 	redoList _ OrderedCollection new.
+ !

Item was added:
+ ----- Method: ChessMorph>>newPiece:white: (in category 'initialize') -----
+ newPiece: piece white: isWhite
+ 	| index selector m |
+ 	index _ piece.
+ 	isWhite ifFalse:[index _ index + 6].
+ 	selector _ #(	
+ 		whitePawnImage
+ 		whiteKnightImage
+ 		whiteBishopImage
+ 		whiteRookImage
+ 		whiteQueenImage
+ 		whiteKingImage
+ 
+ 		blackPawnImage
+ 		blackKnightImage
+ 		blackBishopImage
+ 		blackRookImage
+ 		blackQueenImage
+ 		blackKingImage) at: index.
+ 	m _ ChessPieceMorph new image: (self class perform: selector).
+ 	m setProperty: #isWhite toValue: isWhite.
+ 	m setProperty: #piece toValue: piece.
+ 	^m!

Item was added:
+ ----- Method: ChessMorph>>newSquare (in category 'initialize') -----
+ newSquare
+ 	^BorderedMorph new "or anyone alike"!

Item was added:
+ ----- Method: ChessMorph>>redoMove (in category 'playing') -----
+ redoMove
+ 	"Redo the last undone move"
+ 	redoList isEmpty ifTrue:[^self].
+ 	board nextMove: redoList removeLast.
+ !

Item was added:
+ ----- Method: ChessMorph>>removedPiece:at: (in category 'game callbacks') -----
+ removedPiece: piece at: square
+ 	animateMove ifFalse:[
+ 		(self atSquare: square) removeAllMorphs.
+ 	].!

Item was added:
+ ----- Method: ChessMorph>>replacedPiece:with:at:white: (in category 'game callbacks') -----
+ replacedPiece: oldPiece with: newPiece at: square white: isWhite
+ 	self removedPiece: oldPiece at: square.
+ 	self addedPiece: newPiece at: square white: isWhite!

Item was added:
+ ----- Method: ChessMorph>>rotateBoard (in category 'other stuff') -----
+ rotateBoard
+ 	self listDirection = #leftToRight
+ 		ifTrue:[^self listDirection: #topToBottom; wrapDirection: #leftToRight].
+ 	self listDirection = #topToBottom
+ 		ifTrue:[^self listDirection: #rightToLeft; wrapDirection: #topToBottom].
+ 	self listDirection = #rightToLeft
+ 		ifTrue:[^self listDirection: #bottomToTop; wrapDirection: #rightToLeft].
+ 	self listDirection = #bottomToTop
+ 		ifTrue:[^self listDirection: #leftToRight; wrapDirection: #bottomToTop].
+ !

Item was added:
+ ----- Method: ChessMorph>>showMoves:from: (in category 'events') -----
+ showMoves: evt from: aMorph
+ 	| square |
+ 	square _ aMorph valueOfProperty: #squarePosition.
+ 	square ifNotNil:[^self showMovesAt: square].!

Item was added:
+ ----- Method: ChessMorph>>showMovesAt: (in category 'events') -----
+ showMovesAt: square
+ 	| list |
+ 	board ifNil:[^self].
+ 	board searchAgent isThinking ifTrue:[^self].
+ 	self squaresDo:[:m| m borderWidth: 0].
+ 	list _ board activePlayer findValidMovesAt: square.
+ 	list isEmpty ifTrue:[^self].
+ 	(self atSquare: square) borderWidth: 1.
+ 	list do:[:move|
+ 		(self atSquare: move destinationSquare) borderWidth: 1.
+ 	].!

Item was added:
+ ----- Method: ChessMorph>>squaresDo: (in category 'geometry') -----
+ squaresDo: aBlock
+ 	^submorphs do:[:m| (m hasProperty: #squarePosition) ifTrue:[aBlock value: m]].!

Item was added:
+ ----- Method: ChessMorph>>statusString (in category 'other stuff') -----
+ statusString
+ 	board ifNil:[^''].
+ 	^board statusString!

Item was added:
+ ----- Method: ChessMorph>>step (in category 'stepping and presenter') -----
+ step
+ 	| move |
+ 	board searchAgent isThinking ifTrue:[
+ 		move _ board searchAgent thinkStep.
+ 		move ifNotNil:[
+ 			animateMove _ true.
+ 			board movePieceFrom: move sourceSquare 
+ 					to: move destinationSquare].
+ 	] ifFalse:[
+ 		autoPlay ifTrue:[board searchAgent startThinking].
+ 	].!

Item was added:
+ ----- Method: ChessMorph>>stepTime (in category 'testing') -----
+ stepTime
+ 	^0!

Item was added:
+ ----- Method: ChessMorph>>thinkAndMove (in category 'playing') -----
+ thinkAndMove
+ 	board searchAgent isThinking ifTrue:[^self].
+ 	board searchAgent startThinking.!

Item was added:
+ ----- Method: ChessMorph>>undoMove (in category 'playing') -----
+ undoMove
+ 	"Undo the last move"
+ 	board ifNil:[^self].
+ 	history isEmpty ifTrue:[^self].
+ 	board undoMove: history removeLast.
+ !

Item was added:
+ ----- Method: ChessMorph>>undoMove:white: (in category 'game callbacks') -----
+ undoMove: aMove white: aBool
+ 	board ifNil:[^self].
+ 	redoList addLast: aMove.
+ 	self validateGamePosition.!

Item was added:
+ ----- Method: ChessMorph>>validateGamePosition (in category 'game callbacks') -----
+ validateGamePosition
+ 	"This method does nothing but validating what you see (on screen) is what you get (from the board)."
+ 	| square piece isWhite p |
+ 	1 to: 64 do:[:idx|
+ 		square _ self atSquare: idx.
+ 		square hasSubmorphs 
+ 			ifTrue:[piece _ square firstSubmorph valueOfProperty: #piece.
+ 					isWhite _ square firstSubmorph valueOfProperty: #isWhite]
+ 			ifFalse:[piece _ 0. isWhite _ nil].
+ 		p _ board whitePlayer pieceAt: idx.
+ 		idx = board whitePlayer castlingRookSquare ifTrue:[p _ ChessPlayer rook].
+ 		isWhite == true ifTrue:[
+ 			p = piece ifFalse:[self error:'White broken'].
+ 		] ifFalse:[p = 0 ifFalse:[self error:'White broken']].
+ 		p _ board blackPlayer pieceAt: idx.
+ 		idx = board blackPlayer castlingRookSquare ifTrue:[p _ ChessPlayer rook].
+ 		isWhite == false ifTrue:[
+ 			p = piece ifFalse:[self error:'White broken'].
+ 		] ifFalse:[p = 0 ifFalse:[self error:'White broken']].
+ 	].!

Item was added:
+ ----- Method: ChessMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
+ wantsDroppedMorph: aMorph event: anEvent
+ 	| sourceSquare destSquare |
+ 	(aMorph valueOfProperty: #chessBoard) == self ifFalse:[^false].
+ 	board ifNil:[^true].
+ 	sourceSquare _ aMorph valueOfProperty: #chessBoardSourceSquare.
+ 	destSquare _ self asSquare: aMorph bounds center.
+ 	destSquare ifNil:[^false].
+ 	^board activePlayer isValidMoveFrom: sourceSquare to: destSquare!

Item was added:
+ Object subclass: #ChessMove
+ 	instanceVariableNames: 'movingPiece capturedPiece sourceSquare destinationSquare type value bestMove'
+ 	classVariableNames: 'BasicMoveMask EvalTypeAccurate EvalTypeLowerBound EvalTypeUpperBound ExtractPromotionShift MoveCaptureEnPassant MoveCaptureOrdinary MoveCastlingKingSide MoveCastlingQueenSide MoveDoublePush MoveNormal MovePromotionBishop MovePromotionKnight MovePromotionQueen MovePromotionRook MoveResign MoveStaleMate NoPromotionMask NullMove PromotionMask PromotionShift'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games-Chess'!
+ 
+ !ChessMove commentStamp: '<historical>' prior: 0!
+ I represent a particular move in the chess game.!

Item was added:
+ ----- Method: ChessMove class>>basicMoveMask (in category 'accessing') -----
+ basicMoveMask
+ 	^BasicMoveMask!

Item was added:
+ ----- Method: ChessMove class>>decodeFrom: (in category 'accessing') -----
+ decodeFrom: encodedMove
+ 	^self new moveEncoded: encodedMove!

Item was added:
+ ----- Method: ChessMove class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"ChessMove initialize"
+ 	MoveNormal _ 1.
+ 	MoveDoublePush _ 2.
+ 	MoveCaptureEnPassant _ 3.
+ 	MoveCastlingKingSide _ 4.
+ 	MoveCastlingQueenSide _ 5.
+ 	MoveResign _ 6.
+ 	MoveStaleMate _ 7.
+ 
+ 	BasicMoveMask _ 15.
+ 	PromotionShift _ 4.
+ 	ExtractPromotionShift _  0 - PromotionShift.
+ 
+ 	EvalTypeAccurate _ 0.
+ 	EvalTypeUpperBound _ 1.
+ 	EvalTypeLowerBound _ 2.
+ 
+ 	NullMove _ 0.
+ 
+ !

Item was added:
+ ----- Method: ChessMove>>= (in category 'comparing') -----
+ = aMove
+ 	movingPiece = aMove movingPiece ifFalse:[^false].
+ 	capturedPiece = aMove capturedPiece ifFalse:[^false].
+ 	type = aMove type ifFalse:[^false].
+ 	sourceSquare = aMove sourceSquare ifFalse:[^false].
+ 	destinationSquare = aMove destinationSquare ifFalse:[^false].
+ 	^true!

Item was added:
+ ----- Method: ChessMove>>bestMove (in category 'accessing') -----
+ bestMove
+ 	^nil!

Item was added:
+ ----- Method: ChessMove>>captureEnPassant:from:to: (in category 'initialize') -----
+ captureEnPassant: aPiece from: startSquare to: endSquare
+ 	movingPiece _ capturedPiece _ aPiece.
+ 	sourceSquare _ startSquare.
+ 	destinationSquare _ endSquare.
+ 	type _ MoveCaptureEnPassant.!

Item was added:
+ ----- Method: ChessMove>>capturedPiece (in category 'accessing') -----
+ capturedPiece
+ 	^capturedPiece!

Item was added:
+ ----- Method: ChessMove>>capturedPiece: (in category 'accessing') -----
+ capturedPiece: aValue
+ 	^capturedPiece _ aValue!

Item was added:
+ ----- Method: ChessMove>>checkMate: (in category 'initialize') -----
+ checkMate: aPiece
+ 	movingPiece _ aPiece.
+ 	sourceSquare _ 0.
+ 	destinationSquare _ 0.
+ 	type _ MoveResign.
+ 	capturedPiece _ 0.!

Item was added:
+ ----- Method: ChessMove>>destinationSquare (in category 'accessing') -----
+ destinationSquare
+ 	^destinationSquare!

Item was added:
+ ----- Method: ChessMove>>destinationSquare: (in category 'accessing') -----
+ destinationSquare: aValue
+ 	^destinationSquare _ aValue!

Item was added:
+ ----- Method: ChessMove>>doublePush:from:to: (in category 'initialize') -----
+ doublePush: aPiece from: startSquare to: endSquare
+ 	movingPiece _ aPiece.
+ 	sourceSquare _ startSquare.
+ 	destinationSquare _ endSquare.
+ 	type _ MoveDoublePush.
+ 	capturedPiece _ 0.!

Item was added:
+ ----- Method: ChessMove>>encodedMove (in category 'accessing') -----
+ encodedMove
+ 	"Return an integer encoding enough of a move for printing"
+ 	^destinationSquare + 
+ 		(sourceSquare bitShift: 8) +
+ 		(movingPiece bitShift: 16) +
+ 		(capturedPiece bitShift: 24)!

Item was added:
+ ----- Method: ChessMove>>hash (in category 'comparing') -----
+ hash
+ 	^((movingPiece hash bitXor: capturedPiece hash) bitXor:
+ 		(sourceSquare hash bitXor: destinationSquare hash)) bitXor: type hash!

Item was added:
+ ----- Method: ChessMove>>init (in category 'initialize') -----
+ init
+ 	movingPiece _ sourceSquare _ destinationSquare _ 1.
+ 	type _ MoveNormal.
+ 	capturedPiece _ 0.!

Item was added:
+ ----- Method: ChessMove>>move:from:to: (in category 'initialize') -----
+ move: aPiece from: startSquare to: endSquare
+ 	movingPiece _ aPiece.
+ 	sourceSquare _ startSquare.
+ 	destinationSquare _ endSquare.
+ 	type _ MoveNormal.
+ 	capturedPiece _ 0.!

Item was added:
+ ----- Method: ChessMove>>move:from:to:capture: (in category 'initialize') -----
+ move: aPiece from: startSquare to: endSquare capture: capture
+ 	movingPiece _ aPiece.
+ 	sourceSquare _ startSquare.
+ 	destinationSquare _ endSquare.
+ 	capturedPiece _ capture.
+ 	type _ MoveNormal.
+ !

Item was added:
+ ----- Method: ChessMove>>moveCastlingKingSide:from:to: (in category 'initialize') -----
+ moveCastlingKingSide: aPiece from: startSquare to: endSquare
+ 	movingPiece _ aPiece.
+ 	sourceSquare _ startSquare.
+ 	destinationSquare _ endSquare.
+ 	type _ MoveCastlingKingSide.
+ 	capturedPiece _ 0.!

Item was added:
+ ----- Method: ChessMove>>moveCastlingQueenSide:from:to: (in category 'initialize') -----
+ moveCastlingQueenSide: aPiece from: startSquare to: endSquare
+ 	movingPiece _ aPiece.
+ 	sourceSquare _ startSquare.
+ 	destinationSquare _ endSquare.
+ 	type _ MoveCastlingQueenSide.
+ 	capturedPiece _ 0.!

Item was added:
+ ----- Method: ChessMove>>moveEncoded: (in category 'initialize') -----
+ moveEncoded: encodedMove
+ 	destinationSquare _ encodedMove bitAnd: 255.
+ 	sourceSquare _ (encodedMove bitShift: -8) bitAnd: 255.
+ 	movingPiece _ (encodedMove bitShift: -16) bitAnd: 255.
+ 	capturedPiece _ (encodedMove bitShift: -24) bitAnd: 255.
+ 	type _ MoveNormal.
+ !

Item was added:
+ ----- Method: ChessMove>>moveString (in category 'printing') -----
+ moveString
+ 	^String streamContents:[:aStream|
+ 		aStream nextPutAll: (#('' 'N' 'B' 'R' 'Q' 'K') at: movingPiece).
+ 		aStream nextPutAll: (String with: ($a asInteger + (sourceSquare - 1 bitAnd: 7)) asCharacter with: ($1 asInteger + (sourceSquare -1 bitShift: -3)) asCharacter).
+ 		capturedPiece = 0 ifTrue:[
+ 			aStream nextPutAll: '-'.
+ 		] ifFalse:[
+ 			aStream nextPutAll: 'x'.
+ 			aStream nextPutAll: (#('' 'N' 'B' 'R' 'Q' 'K') at: capturedPiece).
+ 		].
+ 		aStream nextPutAll: (String with: ($a asInteger + (destinationSquare - 1 bitAnd: 7)) asCharacter with: ($1 asInteger + (destinationSquare -1 bitShift: -3)) asCharacter).
+ 	].!

Item was added:
+ ----- Method: ChessMove>>moveType (in category 'accessing') -----
+ moveType
+ 	^type!

Item was added:
+ ----- Method: ChessMove>>moveType: (in category 'accessing') -----
+ moveType: aType
+ 	^type _ aType!

Item was added:
+ ----- Method: ChessMove>>movingPiece (in category 'accessing') -----
+ movingPiece
+ 	^movingPiece!

Item was added:
+ ----- Method: ChessMove>>movingPiece: (in category 'accessing') -----
+ movingPiece: aValue
+ 	^movingPiece _ aValue!

Item was added:
+ ----- Method: ChessMove>>printOn: (in category 'printing') -----
+ printOn: aStream
+ 	super printOn: aStream.
+ 	aStream nextPutAll:'('.
+ 	aStream nextPutAll: (#('' 'N' 'B' 'R' 'Q' 'K') at: movingPiece).
+ 	aStream nextPutAll: (String with: ($a asInteger + (sourceSquare - 1 bitAnd: 7)) asCharacter with: ($1 asInteger + (sourceSquare -1 bitShift: -3)) asCharacter).
+ 	capturedPiece = 0 ifTrue:[
+ 		aStream nextPutAll: '-'.
+ 	] ifFalse:[
+ 		aStream nextPutAll: 'x'.
+ 		aStream nextPutAll: (#('' 'N' 'B' 'R' 'Q' 'K') at: capturedPiece).
+ 	].
+ 	aStream nextPutAll: (String with: ($a asInteger + (destinationSquare - 1 bitAnd: 7)) asCharacter with: ($1 asInteger + (destinationSquare -1 bitShift: -3)) asCharacter).
+ 	aStream nextPutAll:')'.!

Item was added:
+ ----- Method: ChessMove>>promote:to: (in category 'initialize') -----
+ promote: move to: promotion
+ 	movingPiece _ move movingPiece.
+ 	capturedPiece _ move capturedPiece.
+ 	sourceSquare _ move sourceSquare.
+ 	destinationSquare _ move destinationSquare. 
+ 	type _ move moveType.
+ 	type _ type bitOr: (promotion bitShift: PromotionShift).
+ !

Item was added:
+ ----- Method: ChessMove>>promotion (in category 'accessing') -----
+ promotion
+ 	^type bitShift: ExtractPromotionShift!

Item was added:
+ ----- Method: ChessMove>>sourceSquare (in category 'accessing') -----
+ sourceSquare
+ 	^sourceSquare!

Item was added:
+ ----- Method: ChessMove>>sourceSquare: (in category 'accessing') -----
+ sourceSquare: aValue
+ 	^sourceSquare _ aValue!

Item was added:
+ ----- Method: ChessMove>>staleMate: (in category 'initialize') -----
+ staleMate: aPiece
+ 	movingPiece _ aPiece.
+ 	sourceSquare _ 0.
+ 	destinationSquare _ 0.
+ 	type _ MoveStaleMate.
+ 	capturedPiece _ 0.!

Item was added:
+ ----- Method: ChessMove>>value (in category 'accessing') -----
+ value
+ 	^value!

Item was added:
+ ----- Method: ChessMove>>value: (in category 'accessing') -----
+ value: newValue
+ 	value _ newValue!

Item was added:
+ Object subclass: #ChessMoveGenerator
+ 	instanceVariableNames: 'myPlayer myPieces itsPieces castlingStatus enpassantSquare forceCaptures moveList firstMoveIndex lastMoveIndex streamList streamListIndex attackSquares kingAttack'
+ 	classVariableNames: 'EmptyPieceMap'
+ 	poolDictionaries: 'ChessConstants'
+ 	category: 'Etoys-Squeakland-Morphic-Games-Chess'!
+ 
+ !ChessMoveGenerator commentStamp: '<historical>' prior: 0!
+ This class generates moves for any given board. It's speed is critical - for each new position all moves need to be generated in that position. It may be worthwhile to make give this class a little plugin support at some time.!

Item was added:
+ ----- Method: ChessMoveGenerator>>attackSquares (in category 'public') -----
+ attackSquares
+ 	^attackSquares!

Item was added:
+ ----- Method: ChessMoveGenerator>>blackPawnCaptureAt:direction: (in category 'moves-pawns') -----
+ blackPawnCaptureAt: square direction: dir
+ 	| destSquare move piece |
+ 	destSquare _ square-8-dir.
+ 	piece _ itsPieces at: destSquare.
+ 	piece = 0 ifFalse:[
+ 		(move _ moveList at: (lastMoveIndex _ lastMoveIndex + 1))
+ 			move: Pawn from: square to: destSquare capture: piece.
+ 		piece = King ifTrue:[kingAttack _ move].
+ 		destSquare <= 8 "a promotion"
+ 			ifTrue:[self promotePawn: move].
+ 	].
+ 	"attempt an en-passant capture"
+ 	enpassantSquare = destSquare ifTrue:[
+ 		(moveList at: (lastMoveIndex _ lastMoveIndex + 1))
+ 			captureEnPassant: Pawn from: square to: destSquare.
+ 	].!

Item was added:
+ ----- Method: ChessMoveGenerator>>blackPawnPushAt: (in category 'moves-pawns') -----
+ blackPawnPushAt: square
+ 	| destSquare move |
+ 	"Try to push this pawn"
+ 	destSquare _ square-8.
+ 	(myPieces at: destSquare) = 0 ifFalse:[^self].
+ 	(itsPieces at: destSquare) = 0 ifFalse:[^self].
+ 	(move _ moveList at: (lastMoveIndex _ lastMoveIndex + 1))
+ 		move: Pawn from: square to: destSquare.
+ 	destSquare <= 8 "a promotion (can't be double-push so get out)"
+ 		ifTrue:[^self promotePawn: move].
+ 
+ 	"Try to double-push if possible"
+ 	square > 48 ifFalse:[^self].
+ 	destSquare _ square-16.
+ 	(myPieces at: destSquare) = 0 ifFalse:[^self].
+ 	(itsPieces at: destSquare) = 0 ifFalse:[^self].
+ 	(moveList at: (lastMoveIndex _ lastMoveIndex + 1))
+ 		doublePush: Pawn from: square to: destSquare.!

Item was added:
+ ----- Method: ChessMoveGenerator>>canCastleBlackKingSide (in category 'support') -----
+ canCastleBlackKingSide
+ 	(castlingStatus bitAnd: CastlingEnableKingSide) = 0 ifFalse:[^false].
+ 	"Quickly check if all the squares are zero"
+ 	((myPieces at: G8) + (myPieces at: F8) + (itsPieces at: G8) + (itsPieces at: F8) = 0) ifFalse:[^false].
+ 	"Check for castling squares under attack..  See canCastleBlackQueenSide for details"
+ 	(self checkAttack:{H7. H6. H5. H4. H3. H2. H1} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{G7. G6. G5. G4. G3. G2. G1} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{F7. F6. F5. F4. F3. F2. F1} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{E7. E6. E5. E4. E3. E2. E1.} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{D8. C8. B8. A8} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{G7. F6. E5. D4. C3. B2. A1} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{F7. E6. D5. C4. B3. A2} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{E7. D6. C5. B4. A3} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{D7. C6. B5. A4} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{F7. G6. H5} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{G7. H6} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{H7} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkUnprotectedAttack:{H7. G7. F7. E7. D7. C7. H6. G6. F6. E6. D6} fromPiece:Knight) ifTrue:[^false].
+ 	(self checkUnprotectedAttack:{H7. G7. F7. E7. D7} fromPiece:Pawn) ifTrue:[^false].
+ 	^true.
+ 	
+ 	
+ 	
+ 	
+ 	!

Item was added:
+ ----- Method: ChessMoveGenerator>>canCastleBlackQueenSide (in category 'support') -----
+ canCastleBlackQueenSide
+ 	(castlingStatus bitAnd: CastlingEnableQueenSide) = 0 ifFalse:[^false].
+ 	"Quickly check if all the squares are zero"
+ 	((myPieces at: B8) +  (myPieces at: C8) +  (myPieces at: D8) +
+ 		(itsPieces at: B8) + (itsPieces at: C8) + (itsPieces at: D8) 
+ 			= 0) ifFalse:[^false].
+ 	"Check to see if any of the squares involved in castling are under attack.  First
+ 	check for vertical (rook-like) attacks"
+ 	(self checkAttack:{A7. A6. A5. A4. A3. A2. A1} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{B7. B6. B5. B4. B3. B2. B1} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{C7. C6. C5. C4. C3. C2. C1} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{D7. D6. D5. D4. D3. D2. D1} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{E7. E6. E5. E4. E3. E2. E1} fromPieces:RookMovers) ifTrue:[^false].
+ 	"Check for a rook attack from the baseline"
+ 	(self checkAttack:{F8. G8. H8} fromPieces:RookMovers) ifTrue:[^false].
+ 	"Check for bishop attacks from the diagonals"
+ 	(self checkAttack:{B7. C6. D5. E4. F3. G2. H1} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{C7. D6. E5. F4. G3. H2} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{D7. E6. F5. G4. H3} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{E7. F6. G5. H4} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{F7. G6. H5} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{A7} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{B7. A6} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{C7. B6. A5} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{D7. C6. B5. A4} fromPieces:BishopMovers) ifTrue:[^false].
+ 	"Check for a knight attack"
+ 	(self checkUnprotectedAttack:{A7. B7. C7. D7. E7. F7. G7. A6. B6. C6. D6. E6. F6} fromPiece:Knight) ifTrue:[^false].
+ 	"check for a pawn attack"
+ 	(self checkUnprotectedAttack:{A7. B7. C7. D7. E7. F7} fromPiece:Pawn) ifTrue:[^false].
+ 	"check for a king attack"
+ 	(self checkUnprotectedAttack:{B7. C7. } fromPiece:King) ifTrue:[^false].
+ 	^true.
+ !

Item was added:
+ ----- Method: ChessMoveGenerator>>canCastleWhiteKingSide (in category 'support') -----
+ canCastleWhiteKingSide
+ 	(castlingStatus bitAnd: CastlingEnableKingSide) = 0 ifFalse: [^false].
+ 	"Quickly check if all the squares are zero"
+ 	((myPieces at:G1) + (myPieces at:F1) + (itsPieces at:G1) + (itsPieces at:F1) = 0) ifFalse:[^false].
+ 	"Check for castling squares under attack..  See canCastleBlackQueenSide for details"
+ 	(self checkAttack:{H2. H3. H4. H5. H6. H7. H8} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{G2. G3. G4. G5. G6. G7. G8} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{F2. F3. F4. F5. F6. F7. F8} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{E2. E3. E4. E5. E6. E7. E8} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{A1. A2. A3. A4} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{G2. F3. E4. D5. C6. B7. A8} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{F2. E3. D4. C5. B6. A7} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{E2. D3. C4. B5. A6} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{D2. C3. B4. A5} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{F2. G3. H4} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{G2. H3} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{H2} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkUnprotectedAttack:{H2. G2. F2. E2. D2. C2. H3. G3. F3. E3. D3} fromPiece:Knight) ifTrue:[^false].
+ 	(self checkUnprotectedAttack:{H2. G2. F2. E2. D2} fromPiece:Pawn) ifTrue:[^false].
+ 	(self checkUnprotectedAttack:{G2} fromPiece:King) ifTrue:[^false].
+ 	^true.!

Item was added:
+ ----- Method: ChessMoveGenerator>>canCastleWhiteQueenSide (in category 'support') -----
+ canCastleWhiteQueenSide
+ 	(castlingStatus bitAnd: CastlingEnableQueenSide) = 0 ifFalse: [^false].
+ 	"Quickly check if all the squares are zero"
+ 	((myPieces at:B1) + (myPieces at:C1) + (myPieces at:D1) +
+ 	 (itsPieces at:B1) + (itsPieces at:C1) + (itsPieces at:D1) = 0) ifFalse:[^false].
+ 	"Check for castling squares under attack..  See canCastleBlackQueenSide for details"
+ 	(self checkAttack:{A2. A3. A4. A5. A6. A7. A8} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{B2. B3. B4. B5. B6. B7. B8} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{C2. C3. C4. C5. C6. C7. C8} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{D2. D3. D4. D5. D6. D7. D8} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{E2. E3. E4. E5. E6. E7. E8} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{F1. G1. H1} fromPieces:RookMovers) ifTrue:[^false].
+ 	(self checkAttack:{B2. C3. D4. E5. F6. G7. H8} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{C2. D3. E4. F5. G6. H7} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{D2. E3. F4. G5. H6} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{E2. F3. G4. H5} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{F2. G3. H4} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{A2} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{B2. A3} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{C2. B3. A4} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkAttack:{D2. C3. B4. A5} fromPieces:BishopMovers) ifTrue:[^false].
+ 	(self checkUnprotectedAttack:{A2. B2. C2. D2. E2. F2. G2. A3. B3. C3. D3. E3. F3} fromPiece:Knight) ifTrue:[^false].
+ 	(self checkUnprotectedAttack:{A2. B2. C2. D2. E2. F2} fromPiece:Pawn) ifTrue:[^false].
+ 	(self checkUnprotectedAttack:{B2. C2} fromPiece:King) ifTrue:[^false].
+ 	^true.!

Item was added:
+ ----- Method: ChessMoveGenerator>>checkAttack:fromPieces: (in category 'support') -----
+ checkAttack:squares fromPieces:pieces
+ 	"check for an unprotected attack along squares by one of pieces.  Squares is a list of 
+ 	squares such that any piece in pieces can attack unless blocked by another piece.
+ 	E.g., a Bishop of Queen on the file  B7 C6 D5 E4 F3 G2 H1 can attack A8 unless blocked by
+ 	another piece.  To find out if A8 is under attack along B7 C6 D5 E4 F3 G2 H1, use
+ 	checkAttack:{B7. C6.D5. E4. F3. G2. H1} fromPieces:BishopMovers.  Note the order is important;
+ 	squares must be listed in increasing distance from the square of interest"
+ 
+ 	squares do:[:sqr|
+ 		"invariant: no piece has been seen on this file at all"
+ 		"one of my pieces blocks any attack"
+ 		(myPieces at:sqr) = 0 ifFalse:[^false].
+ 		"One of its pieces blocks an attack unless it is the kind of piece that can move along this
+ 		file: a Bishop or Queen for a diagonal and a Rook or Queen for a Horizontal or
+ 		Verrtical File"
+ 		(itsPieces at:sqr) = 0 ifFalse:[
+ 			^pieces includes:(itsPieces at:sqr).
+ 		].
+ 		
+ 	].
+ 	"no pieces along file, no attack"
+ 	^false.
+ 	
+ 	
+ !

Item was added:
+ ----- Method: ChessMoveGenerator>>checkUnprotectedAttack:fromPiece: (in category 'support') -----
+ checkUnprotectedAttack:squares fromPiece:piece
+ 	"check to see if my opponent has a piece of type piece on any of squares.  In general, this
+ 	is used because that piece could launch an attack on me from those squares".
+ 	squares do:[:sqr|
+ 		(itsPieces at:sqr) = piece ifTrue:[^true].
+ 	].
+ 	^false.
+ 	
+ 	
+ !

Item was added:
+ ----- Method: ChessMoveGenerator>>findAllPossibleMovesFor: (in category 'public') -----
+ findAllPossibleMovesFor: player 
+ 	"Find all possible moves. This method does not check if the move is legal, e.g., if the king of the player is under attack after the move. If the opponent is check mate (e.g., the king could be taken in the next move) the method returns nil. If the game is stale mate (e.g., the receiver has no move left) this method returns an empty array."
+ 
+ 	| piece actions square |
+ 	myPlayer := player.
+ 	myPieces := player pieces.
+ 	itsPieces := player opponent pieces.
+ 	castlingStatus := player castlingStatus.
+ 	enpassantSquare := player opponent enpassantSquare.
+ 	firstMoveIndex = lastMoveIndex ifFalse: [self error: 'I am confused'].
+ 	kingAttack := nil.
+ 	myPlayer isWhitePlayer ifTrue:[
+ 		actions := #(moveWhitePawnAt: moveKnightAt: moveBishopAt: 
+ 					moveRookAt: moveQueenAt: moveWhiteKingAt:)
+ 	] ifFalse:[ 
+ 		actions := #(moveBlackPawnAt: moveKnightAt: moveBishopAt: 
+ 					moveRookAt: moveQueenAt: moveBlackKingAt:)
+ 	].
+ 	square := 0.
+ 	[square < 64] whileTrue:[
+ 		"Note: The following is only to skip empty fields efficiently.
+ 		It could well be replaced by going through each field and test it
+ 		for zero but this is *much* faster."
+ 		square := self skipEmptySquaresIn: myPieces
+ 							using: EmptyPieceMap
+ 							startingAt: square + 1.
+ 		square = 0 ifTrue: [^self moveList].
+ 		piece := myPieces at: square.
+ 		self perform: (actions at: piece) with: square.
+ 		kingAttack ifNotNil: [^self moveList].
+ 	].
+ 	^self moveList!

Item was added:
+ ----- Method: ChessMoveGenerator>>findAttackSquaresFor: (in category 'public') -----
+ findAttackSquaresFor: player 
+ 	"Mark all the fields of a board that are attacked by the given player.
+ 	The pieces attacking a field are encoded as (1 << Piece) so that we can
+ 	record all types of pieces that attack the square."
+ 
+ 	| move square piece attack list |
+ 	forceCaptures := false.
+ 	attackSquares ifNil: [attackSquares := ByteArray new: 64].
+ 	attackSquares atAllPut: 0.
+ 	list := self findAllPossibleMovesFor: player.
+ 	
+ 	[move := list next.
+ 	move isNil] whileFalse: 
+ 				[square := move destinationSquare.
+ 				piece := move movingPiece.
+ 				attack := attackSquares at: square.
+ 				attack := attack bitOr: (1 bitShift: piece).
+ 				attackSquares at: square put: attack].
+ 	self recycleMoveList: list.
+ 	^attackSquares!

Item was added:
+ ----- Method: ChessMoveGenerator>>findPossibleMovesFor: (in category 'public') -----
+ findPossibleMovesFor: player
+ 	"Find all possible moves. This method does not check if the move is legal, e.g., if the king of the player is under attack after the move. If the opponent is check mate (e.g., the king could be taken in the next move) the method returns nil. If the game is stale mate (e.g., the receiver has no move left) this method returns an empty array."
+ 	forceCaptures _ false.
+ 	^self findAllPossibleMovesFor: player.!

Item was added:
+ ----- Method: ChessMoveGenerator>>findPossibleMovesFor:at: (in category 'public') -----
+ findPossibleMovesFor: player at: square
+ 	"Find all possible moves at the given square. This method does not check if the move is legal, e.g., if the king of the player is under attack after the move. If the opponent is check mate (e.g., the king could be taken in the next move) the method returns nil. If the game is stale mate (e.g., the receiver has no move left) this method returns an empty array."
+ 	| piece action |
+ 	forceCaptures _ false.
+ 	myPlayer _ player.
+ 	myPieces _ player pieces.
+ 	itsPieces _ player opponent pieces.
+ 	castlingStatus _ player castlingStatus.
+ 	enpassantSquare _ player opponent enpassantSquare.
+ 	firstMoveIndex = lastMoveIndex ifFalse:[self error:'I am confused'].
+ 	kingAttack _ nil.
+ 	piece _ myPieces at: square.
+ 	piece = 0 ifFalse:[
+ 		action _ #(movePawnAt:
+ 					moveKnightAt:
+ 					moveBishopAt:
+ 					moveRookAt:
+ 					moveQueenAt:
+ 					moveKingAt:) at: piece.
+ 		self perform: action with: square.
+ 	].
+ 	^self moveList!

Item was added:
+ ----- Method: ChessMoveGenerator>>findQuiescenceMovesFor: (in category 'public') -----
+ findQuiescenceMovesFor: player
+ 	"Find all the quiescence moves (that is moves capturing pieces)"
+ 	forceCaptures _ true.
+ 	^self findAllPossibleMovesFor: player.!

Item was added:
+ ----- Method: ChessMoveGenerator>>initialize (in category 'initialize') -----
+ initialize
+ 	EmptyPieceMap ifNil:[
+ 		EmptyPieceMap _ ByteArray new: 256.
+ 		2 to: 7 do:[:i| EmptyPieceMap at: i put: 1]].
+ 
+ 	streamList _ Array new: 100. "e.g., 100 plies"
+ 	1 to: streamList size do:[:i| streamList at: i put: (ChessMoveList on: #())].
+ 	moveList _ Array new: streamList size * 30. "avg. 30 moves per ply"
+ 	1 to: moveList size do:[:i| moveList at: i put: (ChessMove new init)].
+ 	firstMoveIndex _ lastMoveIndex _ streamListIndex _ 0.!

Item was added:
+ ----- Method: ChessMoveGenerator>>kingAttack (in category 'public') -----
+ kingAttack
+ 	^kingAttack!

Item was added:
+ ----- Method: ChessMoveGenerator>>moveBishopAt: (in category 'moves-general') -----
+ moveBishopAt: square
+ 	| moves |
+ 	moves _ BishopMoves at: square.
+ 	1 to: moves size do:[:i|
+ 		self movePiece: Bishop along: (moves at: i) at: square.
+ 	].
+ !

Item was added:
+ ----- Method: ChessMoveGenerator>>moveBlackKingAt: (in category 'moves-general') -----
+ moveBlackKingAt: square
+ 	| capture |
+ 	(KingMoves at: square) do:[:destSquare|
+ 		(myPieces at: destSquare) = 0 ifTrue:[
+ 			capture _ itsPieces at: destSquare.
+ 			(forceCaptures and:[capture = 0]) ifFalse:[
+ 				(moveList at: (lastMoveIndex _ lastMoveIndex + 1))
+ 					move: King from: square to: destSquare capture: capture.
+ 				capture = King ifTrue:[kingAttack _ moveList at: lastMoveIndex].
+ 			].
+ 		].
+ 	].
+ 	forceCaptures ifTrue:[^self].
+ 	"now consider castling"
+ 	self canCastleBlackKingSide ifTrue:[
+ 		(moveList at: (lastMoveIndex _ lastMoveIndex + 1))
+ 			moveCastlingKingSide: King from: square to: square+2.
+ 	].
+ 	self canCastleBlackQueenSide ifTrue:[
+ 		(moveList at: (lastMoveIndex _ lastMoveIndex + 1))
+ 			moveCastlingQueenSide: King from: square to: square-2.
+ 	].!

Item was added:
+ ----- Method: ChessMoveGenerator>>moveBlackPawnAt: (in category 'moves-pawns') -----
+ moveBlackPawnAt: square
+ 	"Pawns only move in one direction so check for which direction to use"
+ 	forceCaptures ifFalse:[self blackPawnPushAt: square].
+ 	(square bitAnd: 7) = 1
+ 		ifFalse:[self blackPawnCaptureAt: square direction: 1].
+ 	(square bitAnd: 7) = 0 
+ 		ifFalse:[self blackPawnCaptureAt: square direction: -1].
+ !

Item was added:
+ ----- Method: ChessMoveGenerator>>moveKingAt: (in category 'moves-general') -----
+ moveKingAt: square
+ 	myPlayer isWhitePlayer
+ 		ifTrue:[^self moveWhiteKingAt: square]
+ 		ifFalse:[^self moveBlackKingAt: square]!

Item was added:
+ ----- Method: ChessMoveGenerator>>moveKnightAt: (in category 'moves-general') -----
+ moveKnightAt: square
+ 	| capture moves destSquare |
+ 	moves _ KnightMoves at: square.
+ 	1 to: moves size do:[:i|
+ 		destSquare _ moves at: i.
+ 		(myPieces at: destSquare) = 0 ifTrue:[
+ 			capture _ itsPieces at: destSquare.
+ 			(forceCaptures and:[capture = 0]) ifFalse:[
+ 				(moveList at: (lastMoveIndex _ lastMoveIndex + 1))
+ 					move: Knight from: square to: destSquare capture: capture.
+ 				capture = King ifTrue:[kingAttack _ (moveList at: lastMoveIndex)].
+ 			].
+ 		].
+ 	].!

Item was added:
+ ----- Method: ChessMoveGenerator>>moveList (in category 'public') -----
+ moveList
+ 	| list |
+ 	kingAttack ifNotNil:[
+ 		lastMoveIndex _ firstMoveIndex.
+ 		^nil].
+ 	list _ streamList at: (streamListIndex _ streamListIndex + 1).
+ 	list on: moveList from: firstMoveIndex+1 to: lastMoveIndex.
+ 	firstMoveIndex _ lastMoveIndex.
+ 	^list!

Item was added:
+ ----- Method: ChessMoveGenerator>>movePawnAt: (in category 'moves-general') -----
+ movePawnAt: square
+ 	"Pawns only move in one direction so check for which direction to use"
+ 	myPlayer isWhitePlayer
+ 		ifTrue:[^self moveWhitePawnAt: square]
+ 		ifFalse:[^self moveBlackPawnAt: square]!

Item was added:
+ ----- Method: ChessMoveGenerator>>movePiece:along:at: (in category 'moves-general') -----
+ movePiece: piece along: rayList at: square
+ 	| destSquare capture |
+ 	1 to: rayList size do:[:i|
+ 		destSquare _ rayList at: i.
+ 		(myPieces at: destSquare) = 0 ifFalse:[^self].
+ 		capture _ itsPieces at: destSquare.
+ 		(forceCaptures and:[capture = 0]) ifFalse:[
+ 			(moveList at: (lastMoveIndex _ lastMoveIndex + 1))
+ 				move: piece from: square to: destSquare capture: capture.
+ 			capture = King ifTrue:[kingAttack _ moveList at: lastMoveIndex].
+ 		].
+ 		capture = 0 ifFalse:[^self].
+ 	].!

Item was added:
+ ----- Method: ChessMoveGenerator>>moveQueenAt: (in category 'moves-general') -----
+ moveQueenAt: square
+ 	| moves |
+ 	moves _ RookMoves at: square.
+ 	1 to: moves size do:[:i|
+ 		self movePiece: Queen along: (moves at: i) at: square.
+ 	].
+ 	moves _ BishopMoves at: square.
+ 	1 to: moves size do:[:i|
+ 		self movePiece: Queen along: (moves at: i) at: square.
+ 	].!

Item was added:
+ ----- Method: ChessMoveGenerator>>moveRookAt: (in category 'moves-general') -----
+ moveRookAt: square
+ 	| moves |
+ 	moves _ RookMoves at: square.
+ 	1 to: moves size do:[:i|
+ 		self movePiece: Rook along: (moves at: i) at: square.
+ 	].
+ !

Item was added:
+ ----- Method: ChessMoveGenerator>>moveWhiteKingAt: (in category 'moves-general') -----
+ moveWhiteKingAt: square
+ 	| capture |
+ 	(KingMoves at: square) do:[:destSquare|
+ 		(myPieces at: destSquare) = 0 ifTrue:[
+ 			capture _ itsPieces at: destSquare.
+ 			(forceCaptures and:[capture = 0]) ifFalse:[
+ 				(moveList at: (lastMoveIndex _ lastMoveIndex + 1))
+ 					move: King from: square to: destSquare capture: capture.
+ 				capture = King ifTrue:[kingAttack _ moveList at: lastMoveIndex].
+ 			].
+ 		].
+ 	].
+ 	forceCaptures ifTrue:[^self].
+ 	"now consider castling"
+ 	self canCastleWhiteKingSide ifTrue:[
+ 		(moveList at: (lastMoveIndex _ lastMoveIndex + 1))
+ 			moveCastlingKingSide: King from: square to: square+2.
+ 	].
+ 	self canCastleWhiteQueenSide ifTrue:[
+ 		(moveList at: (lastMoveIndex _ lastMoveIndex + 1))
+ 			moveCastlingQueenSide: King from: square to: square-2.
+ 	].!

Item was added:
+ ----- Method: ChessMoveGenerator>>moveWhitePawnAt: (in category 'moves-pawns') -----
+ moveWhitePawnAt: square
+ 	"Pawns only move in one direction so check for which direction to use"
+ 	forceCaptures ifFalse:[self whitePawnPushAt: square].
+ 	(square bitAnd: 7) = 0 
+ 		ifFalse:[self whitePawnCaptureAt: square direction: 1].
+ 	(square bitAnd: 7) = 1 
+ 		ifFalse:[self whitePawnCaptureAt: square direction: -1].
+ !

Item was added:
+ ----- Method: ChessMoveGenerator>>profileGenerationFor: (in category 'public') -----
+ profileGenerationFor: player
+ 	| list |
+ 	Smalltalk garbageCollect.
+ 	MessageTally spyOn:[
+ 		1 to: 100000 do:[:i|
+ 			list _ self findPossibleMovesFor: player.
+ 			self recycleMoveList: list].
+ 	].
+ !

Item was added:
+ ----- Method: ChessMoveGenerator>>promotePawn: (in category 'moves-pawns') -----
+ promotePawn: move
+ 	"Duplicate the given move and embed all promotion types"
+ 	(moveList at: (lastMoveIndex _ lastMoveIndex + 1)) promote: move to: Knight.
+ 	(moveList at: (lastMoveIndex _ lastMoveIndex + 1)) promote: move to: Bishop.
+ 	(moveList at: (lastMoveIndex _ lastMoveIndex + 1)) promote: move to: Rook.
+ 	move promote: move to: Queen.!

Item was added:
+ ----- Method: ChessMoveGenerator>>recycleMoveList: (in category 'public') -----
+ recycleMoveList: aChessMoveList
+ 	(streamList at: streamListIndex) == aChessMoveList ifFalse:[^self error:'I am confused'].
+ 	streamListIndex _ streamListIndex - 1.
+ 	firstMoveIndex _ lastMoveIndex _ aChessMoveList startIndex - 1.
+ !

Item was added:
+ ----- Method: ChessMoveGenerator>>skipEmptySquaresIn:using:startingAt: (in category 'private') -----
+ skipEmptySquaresIn: pieces using: aMap startingAt: startIndex
+ 	"Find the first empty (zero) square in pieces. The method is layed out so we can (re)use the a particularly effective String primitive (which requires the map argument) but the failure code will do the more natural search for zero instead of the actual primitive equivalent."
+ 	<primitive: 'primitiveFindFirstInString' module: 'MiscPrimitivePlugin'>
+ 	startIndex to: pieces size do:[:index|
+ 		(pieces at: index) = 0 ifFalse:[^index].
+ 	].
+ 	^0!

Item was added:
+ ----- Method: ChessMoveGenerator>>whitePawnCaptureAt:direction: (in category 'moves-pawns') -----
+ whitePawnCaptureAt: square direction: dir
+ 	| destSquare move piece |
+ 	destSquare _ square+8+dir.
+ 	piece _ itsPieces at: destSquare.
+ 	piece = 0 ifFalse:[
+ 		(move _ moveList at: (lastMoveIndex _ lastMoveIndex + 1))
+ 			move: Pawn from: square to: destSquare capture: piece.
+ 		piece = King ifTrue:[kingAttack _ move].
+ 		destSquare > 56 "a promotion"
+ 			ifTrue:[self promotePawn: move].
+ 	].
+ 	"attempt an en-passant capture"
+ 	enpassantSquare = destSquare ifTrue:[
+ 		(moveList at: (lastMoveIndex _ lastMoveIndex + 1))
+ 			captureEnPassant: Pawn from: square to: destSquare.
+ 	].!

Item was added:
+ ----- Method: ChessMoveGenerator>>whitePawnPushAt: (in category 'moves-pawns') -----
+ whitePawnPushAt: square
+ 	"Pawns only move in one direction so check for which direction to use"
+ 	| destSquare move |
+ 	"Try to push this pawn"
+ 	destSquare _ square+8.
+ 
+ 	(myPieces at: destSquare) = 0 ifFalse:[^self].
+ 	(itsPieces at: destSquare) = 0 ifFalse:[^self].
+ 	(move _ moveList at: (lastMoveIndex _ lastMoveIndex + 1))
+ 		move: Pawn from: square to: destSquare.
+ 	destSquare > 56 "a promotion (can't be double-push so get out)"
+ 		ifTrue:[^self promotePawn: move].
+ 
+ 	"Try to double-push if possible"
+ 	square <= 16 ifFalse:[^self].
+ 	destSquare _ square+16.
+ 	(myPieces at: destSquare) = 0 ifFalse:[^self].
+ 	(itsPieces at: destSquare) = 0 ifFalse:[^self].
+ 	(moveList at: (lastMoveIndex _ lastMoveIndex + 1))
+ 		doublePush: Pawn from: square to: destSquare.!

Item was added:
+ ReadStream subclass: #ChessMoveList
+ 	instanceVariableNames: 'startIndex'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games-Chess'!
+ 
+ !ChessMoveList commentStamp: '<historical>' prior: 0!
+ An optimized representation of a set of moves - mainly there to avoid excessive allocation (and garbage collections) in a few critical places.!

Item was added:
+ ----- Method: ChessMoveList>>contents (in category 'accessing') -----
+ contents
+ 	^collection copyFrom: startIndex to: readLimit!

Item was added:
+ ----- Method: ChessMoveList>>on:from:to: (in category 'private') -----
+ on: aCollection from: firstIndex to: lastIndex
+ 	startIndex _ firstIndex.
+ 	^super on: aCollection from: firstIndex to: lastIndex.
+ !

Item was added:
+ ----- Method: ChessMoveList>>sort:to:using: (in category 'sorting') -----
+ sort: i to: j using: sorter
+ 	"Sort elements i through j of self to be nondescending according to sorter."
+ 
+ 	| di dij dj tt ij k l n |
+ 	"The prefix d means the data at that index."
+ 	(n _ j + 1  - i) <= 1 ifTrue: [^self].	"Nothing to sort." 
+ 	 "Sort di,dj."
+ 	di _ collection at: i.
+ 	dj _ collection at: j.
+ 	(sorter sorts: di before: dj) ifFalse:["i.e., should di precede dj?"
+ 		collection swap: i with: j.
+ 		tt _ di. di _ dj. dj _ tt].
+ 	n > 2 ifTrue:["More than two elements."
+ 		ij _ (i + j) // 2.  "ij is the midpoint of i and j."
+ 		 dij _ collection at: ij.  "Sort di,dij,dj.  Make dij be their median."
+ 		 (sorter sorts: di before: dij) ifTrue:["i.e. should di precede dij?"
+ 			(sorter sorts: dij before: dj) "i.e., should dij precede dj?"
+ 				ifFalse:[collection swap: j with: ij.
+ 					 	dij _ dj].
+ 		] ifFalse:[  "i.e. di should come after dij"
+ 			collection swap: i with: ij.
+ 			 dij _ di
+ 		].
+ 		n > 3 ifTrue:["More than three elements."
+ 			"Find k>i and l<j such that dk,dij,dl are in reverse order.
+ 			Swap k and l.  Repeat this procedure until k and l pass each other."
+ 			 k _ i.  l _ j.
+ 			[
+ 				[l _ l - 1.  k <= l and: [sorter sorts: dij before: (collection at: l)]]
+ 					whileTrue.  "i.e. while dl succeeds dij"
+ 				[k _ k + 1.  k <= l and: [sorter sorts: (collection at: k) before: dij]]
+ 					whileTrue.  "i.e. while dij succeeds dk"
+ 				k <= l
+ 			] whileTrue:[collection swap: k with: l]. 
+ 			"Now l<k (either 1 or 2 less), and di through dl are all less than 
+ 			or equal to dk through dj.  Sort those two segments."
+ 			self sort: i to: l using: sorter.
+ 			self sort: k to: j using: sorter]].
+ !

Item was added:
+ ----- Method: ChessMoveList>>sortUsing: (in category 'sorting') -----
+ sortUsing: historyTable
+ 	^self sort: startIndex to: readLimit using: historyTable!

Item was added:
+ ----- Method: ChessMoveList>>startIndex (in category 'accessing') -----
+ startIndex
+ 	^startIndex!

Item was added:
+ ImageMorph subclass: #ChessPieceMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games-Chess'!

Item was added:
+ ----- Method: ChessPieceMorph>>wantsToBeDroppedInto: (in category 'dropping/grabbing') -----
+ wantsToBeDroppedInto: aMorph
+ 	^aMorph isKindOf: ChessMorph!

Item was added:
+ Object subclass: #ChessPlayer
+ 	instanceVariableNames: 'board pieces opponent castlingRookSquare enpassantSquare castlingStatus materialValue numPawns positionalValue'
+ 	classVariableNames: ''
+ 	poolDictionaries: 'ChessConstants'
+ 	category: 'Etoys-Squeakland-Morphic-Games-Chess'!
+ 
+ !ChessPlayer commentStamp: '<historical>' prior: 0!
+ This class represents a player in the game, including its pieces and the current value of the player's position.!

Item was added:
+ ----- Method: ChessPlayer class>>king (in category 'accessing') -----
+ king
+ 	^King!

Item was added:
+ ----- Method: ChessPlayer class>>rook (in category 'accessing') -----
+ rook
+ 	^Rook!

Item was added:
+ ----- Method: ChessPlayer>>addBlackPieces (in category 'adding/removing') -----
+ addBlackPieces
+ 	self initialize.
+ 	49 to: 56 do:[:i| self addPiece: Pawn at: i].
+ 	self addPiece: Rook at: 57.
+ 	self addPiece: Knight at: 58.
+ 	self addPiece: Bishop at: 59.
+ 	self addPiece: Queen at: 60.
+ 	self addPiece: King at: 61.
+ 	self addPiece: Bishop at: 62.
+ 	self addPiece: Knight at: 63.
+ 	self addPiece: Rook at: 64.
+ !

Item was added:
+ ----- Method: ChessPlayer>>addPiece:at: (in category 'adding/removing') -----
+ addPiece: piece at: square
+ 	pieces at: square put: piece.
+ 	materialValue _ materialValue + (PieceValues at: piece).
+ 	positionalValue _ positionalValue + ((PieceCenterScores at: piece) at: square).
+ 	piece = Pawn ifTrue:[numPawns _ numPawns + 1].
+ 	board updateHash: piece at: square from: self.
+ 	self userAgent ifNotNil:[self userAgent addedPiece: piece at: square white: self isWhitePlayer].!

Item was added:
+ ----- Method: ChessPlayer>>addWhitePieces (in category 'adding/removing') -----
+ addWhitePieces
+ 	self addPiece: Rook at: 1.
+ 	self addPiece: Knight at: 2.
+ 	self addPiece: Bishop at: 3.
+ 	self addPiece: Queen at: 4.
+ 	self addPiece: King at: 5.
+ 	self addPiece: Bishop at: 6.
+ 	self addPiece: Knight at: 7.
+ 	self addPiece: Rook at: 8.
+ 	9 to: 16 do:[:i| self addPiece: Pawn at: i].
+ !

Item was added:
+ ----- Method: ChessPlayer>>applyCastleKingSideMove: (in category 'moving') -----
+ applyCastleKingSideMove: move
+ 	self movePiece: move movingPiece from: move sourceSquare to: move destinationSquare.
+ 	self movePiece: Rook from: move sourceSquare+3 to: (castlingRookSquare _ move sourceSquare+1).
+ 	pieces at: castlingRookSquare put: King.
+ 	castlingStatus _ castlingStatus bitOr: CastlingDone.!

Item was added:
+ ----- Method: ChessPlayer>>applyCastleQueenSideMove: (in category 'moving') -----
+ applyCastleQueenSideMove: move
+ 	self movePiece: move movingPiece from: move sourceSquare to: move destinationSquare.
+ 	self movePiece: Rook from: move sourceSquare-4 to: (castlingRookSquare _ move sourceSquare-1).
+ 	pieces at: castlingRookSquare put: King.
+ 	castlingStatus _ castlingStatus bitOr: CastlingDone.!

Item was added:
+ ----- Method: ChessPlayer>>applyDoublePushMove: (in category 'moving') -----
+ applyDoublePushMove: move
+ 	enpassantSquare _ (move sourceSquare + move destinationSquare) bitShift: -1.
+ 	"Above means: the field between start and destination"
+ 	^self movePiece: move movingPiece from: move sourceSquare to: move destinationSquare.!

Item was added:
+ ----- Method: ChessPlayer>>applyEnpassantMove: (in category 'moving') -----
+ applyEnpassantMove: move
+ 	opponent removePiece: move capturedPiece at: move destinationSquare - 
+ 		(self isWhitePlayer ifTrue:[8] ifFalse:[-8]).
+ 	^self movePiece: move movingPiece from: move sourceSquare to: move destinationSquare!

Item was added:
+ ----- Method: ChessPlayer>>applyMove: (in category 'moving') -----
+ applyMove: move
+ 	"Apply the given move"
+ 	| action |
+ 	"Apply basic move"
+ 	action _ #(
+ 			applyNormalMove:
+ 			applyDoublePushMove:
+ 			applyEnpassantMove:
+ 			applyCastleKingSideMove:
+ 			applyCastleQueenSideMove:
+ 			applyResign:
+ 			applyStaleMate:
+ 		) at: (move moveType bitAnd: ChessMove basicMoveMask).
+ 	self perform: action with: move.
+ 
+ 	"Promote if necessary"
+ 	self applyPromotion: move.
+ 
+ 	"Maintain castling status"
+ 	self updateCastlingStatus: move.
+ !

Item was added:
+ ----- Method: ChessPlayer>>applyNormalMove: (in category 'moving') -----
+ applyNormalMove: move
+ 	| piece |
+ 	(piece _ move capturedPiece) = EmptySquare 
+ 		ifFalse:[opponent removePiece: piece at: move destinationSquare].
+ 	^self movePiece: move movingPiece from: move sourceSquare to: move destinationSquare.!

Item was added:
+ ----- Method: ChessPlayer>>applyPromotion: (in category 'moving') -----
+ applyPromotion: move
+ 	| piece |
+ 	piece _ move promotion.
+ 	piece = 0 ifFalse:[self replacePiece: move movingPiece with: piece at: move destinationSquare].!

Item was added:
+ ----- Method: ChessPlayer>>applyResign: (in category 'moving') -----
+ applyResign: move
+ 	"Give up."
+ 	self userAgent ifNotNil:[
+ 		self isWhitePlayer 
+ 			ifTrue:[self userAgent finishedGame: 0]
+ 			ifFalse:[self userAgent finishedGame: 1].
+ 	].!

Item was added:
+ ----- Method: ChessPlayer>>applyStaleMate: (in category 'moving') -----
+ applyStaleMate: move
+ 	"Itsa draw."
+ 	self userAgent ifNotNil:[self userAgent finishedGame: 0.5].!

Item was added:
+ ----- Method: ChessPlayer>>board (in category 'accessing') -----
+ board
+ 	^board!

Item was added:
+ ----- Method: ChessPlayer>>board: (in category 'accessing') -----
+ board: aBoard
+ 	board _ aBoard!

Item was added:
+ ----- Method: ChessPlayer>>canCastleKingSide (in category 'testing') -----
+ canCastleKingSide
+ 	(castlingStatus bitAnd: CastlingEnableKingSide) = 0 ifFalse: [^false].
+ 	self isWhitePlayer 
+ 		ifTrue: 
+ 			[(pieces sixth) = 0 ifFalse: [^false].
+ 			pieces seventh = 0 ifFalse: [^false].
+ 			(opponent pieceAt: 6) = 0 ifFalse: [^false].
+ 			(opponent pieceAt: 7) = 0 ifFalse: [^false]]
+ 		ifFalse: 
+ 			[(pieces at: 62) = 0 ifFalse: [^false].
+ 			(pieces at: 63) = 0 ifFalse: [^false].
+ 			(opponent pieceAt: 62) = 0 ifFalse: [^false].
+ 			(opponent pieceAt: 63) = 0 ifFalse: [^false]].
+ 	^true!

Item was added:
+ ----- Method: ChessPlayer>>canCastleQueenSide (in category 'testing') -----
+ canCastleQueenSide
+ 	(castlingStatus bitAnd: CastlingEnableQueenSide) = 0 ifFalse: [^false].
+ 	self isWhitePlayer 
+ 		ifTrue: 
+ 			[pieces second = 0 ifFalse: [^false].
+ 			(pieces third) = 0 ifFalse: [^false].
+ 			pieces fourth = 0 ifFalse: [^false].
+ 			(opponent pieceAt: 2) = 0 ifFalse: [^false].
+ 			(opponent pieceAt: 3) = 0 ifFalse: [^false].
+ 			(opponent pieceAt: 4) = 0 ifFalse: [^false]]
+ 		ifFalse: 
+ 			[(pieces at: 58) = 0 ifFalse: [^false].
+ 			(pieces at: 59) = 0 ifFalse: [^false].
+ 			(pieces at: 60) = 0 ifFalse: [^false].
+ 			(opponent pieceAt: 58) = 0 ifFalse: [^false].
+ 			(opponent pieceAt: 59) = 0 ifFalse: [^false].
+ 			(opponent pieceAt: 60) = 0 ifFalse: [^false]].
+ 	^true!

Item was added:
+ ----- Method: ChessPlayer>>castlingRookSquare (in category 'accessing') -----
+ castlingRookSquare
+ 	^castlingRookSquare!

Item was added:
+ ----- Method: ChessPlayer>>castlingStatus (in category 'accessing') -----
+ castlingStatus
+ 	^castlingStatus!

Item was added:
+ ----- Method: ChessPlayer>>copy (in category 'copying') -----
+ copy
+ 	^self shallowCopy postCopy!

Item was added:
+ ----- Method: ChessPlayer>>copyPlayer: (in category 'copying') -----
+ copyPlayer: aPlayer
+ 	"Copy all the volatile state from aPlayer"
+ 	castlingRookSquare _ aPlayer castlingRookSquare.
+ 	enpassantSquare _ aPlayer enpassantSquare.
+ 	castlingStatus _ aPlayer castlingStatus.
+ 	materialValue _ aPlayer materialValue.
+ 	numPawns _ aPlayer numPawns.
+ 	positionalValue _ aPlayer positionalValue.
+ 	pieces replaceFrom: 1 to: pieces size with: aPlayer pieces startingAt: 1.!

Item was added:
+ ----- Method: ChessPlayer>>enpassantSquare (in category 'accessing') -----
+ enpassantSquare
+ 	^enpassantSquare!

Item was added:
+ ----- Method: ChessPlayer>>evaluate (in category 'evaluation') -----
+ evaluate
+ 	^self evaluateMaterial + self evaluatePosition!

Item was added:
+ ----- Method: ChessPlayer>>evaluateMaterial (in category 'evaluation') -----
+ evaluateMaterial
+ 	"Compute the board's material balance, from the point of view of the side
+ 	player.  This is an exact clone of the eval function in CHESS 4.5"
+ 	| total diff value |
+ 	self materialValue = opponent materialValue ifTrue:[^0]. "both sides are equal"
+ 	total _ self materialValue + opponent materialValue.
+ 	diff _ self materialValue - opponent materialValue.
+ 	value _ (2400 min: diff) + 
+ 		((diff * (12000 - total) * self numPawns) // (6400 * (self numPawns + 1))).
+ 	^value!

Item was added:
+ ----- Method: ChessPlayer>>evaluatePosition (in category 'evaluation') -----
+ evaluatePosition
+ 	"Compute the board's positional balance, from the point of view of the side player."
+ 	^positionalValue - opponent positionalValue!

Item was added:
+ ----- Method: ChessPlayer>>findPossibleMoves (in category 'moves-general') -----
+ findPossibleMoves
+ 	"Find all possible moves. This method does not check if the move is legal, e.g., if the king of the player is under attack after the move. If the opponent is check mate (e.g., the king could be taken in the next move) the method returns nil. If the game is stale mate (e.g., the receiver has no move left) this method returns an empty array."
+ 	| moveList moves |
+ 	moveList _ board generator findPossibleMovesFor: self.
+ 	moveList ifNil:[^nil].
+ 	moves _ moveList contents collect:[:move| move copy].
+ 	board generator recycleMoveList: moveList.
+ 	^moves!

Item was added:
+ ----- Method: ChessPlayer>>findPossibleMovesAt: (in category 'moves-general') -----
+ findPossibleMovesAt: square
+ 	"Find all possible moves at the given square. This method does not check if the move is legal, e.g., if the king of the player is under attack after the move. If the opponent is check mate (e.g., the king could be taken in the next move) the method returns nil. If the game is stale mate (e.g., the receiver has no move left) this method returns an empty array."
+ 	| moveList moves |
+ 	moveList _ board generator findPossibleMovesFor: self at: square.
+ 	moveList ifNil:[^nil].
+ 	moves _ moveList contents collect:[:move| move copy].
+ 	board generator recycleMoveList: moveList.
+ 	^moves!

Item was added:
+ ----- Method: ChessPlayer>>findQuiescenceMoves (in category 'moves-general') -----
+ findQuiescenceMoves
+ 	"Find all possible moves. This method does not check if the move is legal, e.g., if the king of the player is under attack after the move. If the opponent is check mate (e.g., the king could be taken in the next move) the method returns nil. If the game is stale mate (e.g., the receiver has no move left) this method returns an empty array."
+ 	| moveList moves |
+ 	moveList _ board generator findQuiescenceMovesFor: self.
+ 	moveList ifNil:[^nil].
+ 	moves _ moveList contents collect:[:move| move copy].
+ 	board generator recycleMoveList: moveList.
+ 	^moves!

Item was added:
+ ----- Method: ChessPlayer>>findValidMoves (in category 'moves-general') -----
+ findValidMoves
+ 	"Find all the valid moves"
+ 	| moveList |
+ 	moveList _ self findPossibleMoves ifNil:[^nil].
+ 	^moveList select:[:move| self isValidMove: move].!

Item was added:
+ ----- Method: ChessPlayer>>findValidMovesAt: (in category 'moves-general') -----
+ findValidMovesAt: square
+ 	"Find all the valid moves"
+ 	| moveList |
+ 	moveList _ (self findPossibleMovesAt: square) ifNil:[^nil].
+ 	^moveList select:[:move| self isValidMove: move].!

Item was added:
+ ----- Method: ChessPlayer>>initialize (in category 'initialize') -----
+ initialize
+ 	"ChessPlayer initialize"
+ 	pieces _ ByteArray new: 64.
+ 	materialValue _ 0.
+ 	positionalValue _ 0.
+ 	numPawns _ 0.
+ 	enpassantSquare _ 0.
+ 	castlingRookSquare _ 0.
+ 	castlingStatus _ 0.!

Item was added:
+ ----- Method: ChessPlayer>>isValidMove: (in category 'testing') -----
+ isValidMove: move
+ 	"Is the given move actually valid for the receiver?
+ 	If the receiver's king can't be taken after applying the move, it is."
+ 	| copy |
+ 	copy _ board copy.
+ 	copy nextMove: move.
+ 	^copy activePlayer findPossibleMoves notNil!

Item was added:
+ ----- Method: ChessPlayer>>isValidMoveFrom:to: (in category 'testing') -----
+ isValidMoveFrom: sourceSquare to: destSquare
+ 	| move |
+ 	move _ (self findValidMovesAt: sourceSquare)
+ 			detect:[:any| any destinationSquare = destSquare] ifNone:[nil].
+ 	^move notNil!

Item was added:
+ ----- Method: ChessPlayer>>isWhitePlayer (in category 'testing') -----
+ isWhitePlayer
+ 	^board whitePlayer == self!

Item was added:
+ ----- Method: ChessPlayer>>materialValue (in category 'accessing') -----
+ materialValue
+ 	^materialValue!

Item was added:
+ ----- Method: ChessPlayer>>movePiece:from:to: (in category 'adding/removing') -----
+ movePiece: piece from: sourceSquare to: destSquare
+ 	| score |
+ 	score _ PieceCenterScores at: piece.
+ 	positionalValue _ positionalValue - (score at: sourceSquare).
+ 	positionalValue _ positionalValue + (score at: destSquare).
+ 	pieces at: sourceSquare put: 0.
+ 	pieces at: destSquare put: piece.
+ 	board updateHash: piece at: sourceSquare from: self.
+ 	board updateHash: piece at: destSquare from: self.
+ 	self userAgent ifNotNil:[self userAgent movedPiece: piece from: sourceSquare to: destSquare].!

Item was added:
+ ----- Method: ChessPlayer>>numPawns (in category 'accessing') -----
+ numPawns
+ 	^numPawns!

Item was added:
+ ----- Method: ChessPlayer>>opponent (in category 'accessing') -----
+ opponent
+ 	^opponent!

Item was added:
+ ----- Method: ChessPlayer>>opponent: (in category 'accessing') -----
+ opponent: aPlayer
+ 	opponent _ aPlayer!

Item was added:
+ ----- Method: ChessPlayer>>pieceAt: (in category 'accessing') -----
+ pieceAt: square
+ 	"Return the piece at the given square"
+ 	^pieces at: square!

Item was added:
+ ----- Method: ChessPlayer>>pieces (in category 'accessing') -----
+ pieces
+ 	^pieces!

Item was added:
+ ----- Method: ChessPlayer>>positionalValue (in category 'evaluation') -----
+ positionalValue
+ 	"Evaluate our current position"
+ 	^positionalValue!

Item was added:
+ ----- Method: ChessPlayer>>postCopy (in category 'copying') -----
+ postCopy
+ 	pieces _ pieces clone.!

Item was added:
+ ----- Method: ChessPlayer>>prepareNextMove (in category 'initialize') -----
+ prepareNextMove
+ 	"Clear enpassant square and reset any pending extra kings"
+ 	enpassantSquare _ 0.
+ 	castlingRookSquare = 0 ifFalse:[pieces at: castlingRookSquare put: Rook].
+ 	castlingRookSquare _ 0.
+ !

Item was added:
+ ----- Method: ChessPlayer>>removePiece:at: (in category 'adding/removing') -----
+ removePiece: piece at: square
+ 	pieces at: square put: 0.
+ 	materialValue _ materialValue - (PieceValues at: piece).
+ 	positionalValue _ positionalValue - ((PieceCenterScores at: piece) at: square).
+ 	piece = Pawn ifTrue:[numPawns _ numPawns - 1].
+ 	board updateHash: piece at: square from: self.
+ 	self userAgent ifNotNil:[self userAgent removedPiece: piece at: square].!

Item was added:
+ ----- Method: ChessPlayer>>replacePiece:with:at: (in category 'adding/removing') -----
+ replacePiece: oldPiece with: newPiece at: square
+ 	pieces at: square put: newPiece.
+ 	materialValue _ materialValue - (PieceValues at: oldPiece) + (PieceValues at: newPiece).
+ 	positionalValue _ positionalValue - ((PieceCenterScores at: oldPiece) at: square).
+ 	positionalValue _ positionalValue + ((PieceCenterScores at: newPiece) at: square).
+ 
+ 	oldPiece = Pawn ifTrue:[numPawns _ numPawns - 1].
+ 	newPiece = Pawn ifTrue:[numPawns _ numPawns + 1].
+ 	board updateHash: oldPiece at: square from: self.
+ 	board updateHash: newPiece at: square from: self.
+ 	self userAgent ifNotNil:[self userAgent replacedPiece: oldPiece with: newPiece at: square white: self isWhitePlayer].!

Item was added:
+ ----- Method: ChessPlayer>>undoCastleKingSideMove: (in category 'undo') -----
+ undoCastleKingSideMove: move
+ 	self prepareNextMove. "in other words, remove extra kings"
+ 	self movePiece: move movingPiece from: move destinationSquare to: move sourceSquare.
+ 	self movePiece: Rook from: move sourceSquare+1 to: move sourceSquare+3.!

Item was added:
+ ----- Method: ChessPlayer>>undoCastleQueenSideMove: (in category 'undo') -----
+ undoCastleQueenSideMove: move
+ 	self prepareNextMove. "in other words, remove extra kings"
+ 	self movePiece: move movingPiece from: move destinationSquare to: move sourceSquare.
+ 	self movePiece: Rook from: move sourceSquare-1 to: move sourceSquare-4.
+ !

Item was added:
+ ----- Method: ChessPlayer>>undoDoublePushMove: (in category 'undo') -----
+ undoDoublePushMove: move
+ 	enpassantSquare _ 0.
+ 	self movePiece: move movingPiece from: move destinationSquare to: move sourceSquare.!

Item was added:
+ ----- Method: ChessPlayer>>undoEnpassantMove: (in category 'undo') -----
+ undoEnpassantMove: move
+ 	self movePiece: move movingPiece from: move destinationSquare to: move sourceSquare.
+ 	opponent addPiece: move capturedPiece at: move destinationSquare - 
+ 		(self isWhitePlayer ifTrue:[8] ifFalse:[-8]).
+ !

Item was added:
+ ----- Method: ChessPlayer>>undoMove: (in category 'undo') -----
+ undoMove: move
+ 	"Undo the given move"
+ 	| action |
+ 	self undoPromotion: move.
+ 	"Apply basic move"
+ 	action _ #(
+ 			undoNormalMove:
+ 			undoDoublePushMove:
+ 			undoEnpassantMove:
+ 			undoCastleKingSideMove:
+ 			undoCastleQueenSideMove:
+ 			undoResign:
+ 			undoStaleMate:
+ 		) at: (move moveType bitAnd: ChessMove basicMoveMask).
+ 	self perform: action with: move.!

Item was added:
+ ----- Method: ChessPlayer>>undoNormalMove: (in category 'undo') -----
+ undoNormalMove: move
+ 	| piece |
+ 	self movePiece: move movingPiece from: move destinationSquare to: move sourceSquare.
+ 	(piece _ move capturedPiece) = EmptySquare 
+ 		ifFalse:[opponent addPiece: piece at: move destinationSquare].
+ !

Item was added:
+ ----- Method: ChessPlayer>>undoPromotion: (in category 'undo') -----
+ undoPromotion: move
+ 	| piece |
+ 	piece _ move promotion.
+ 	piece = 0 ifFalse:[self replacePiece: piece with: move movingPiece at: move destinationSquare].!

Item was added:
+ ----- Method: ChessPlayer>>undoResign: (in category 'undo') -----
+ undoResign: move!

Item was added:
+ ----- Method: ChessPlayer>>undoStaleMate: (in category 'undo') -----
+ undoStaleMate: move!

Item was added:
+ ----- Method: ChessPlayer>>updateCastlingStatus: (in category 'moving') -----
+ updateCastlingStatus: move
+ 
+ 	"Cannot castle when king has moved"
+ 	(move movingPiece = King) 
+ 		ifTrue:[^castlingStatus _ castlingStatus bitOr: CastlingDisableAll].
+ 
+ 	"See if a rook has moved"
+ 	(move movingPiece = Rook) ifFalse:[^self].
+ 
+ 	self isWhitePlayer ifTrue:[
+ 		(move sourceSquare = 1) 
+ 			ifTrue:[^castlingStatus _ castlingStatus bitOr: CastlingDisableQueenSide].
+ 		(move sourceSquare = 8) 
+ 			ifTrue:[^castlingStatus _ castlingStatus bitOr: CastlingDisableKingSide].
+ 	] ifFalse:[
+ 		(move sourceSquare = 57) 
+ 			ifTrue:[^castlingStatus _ castlingStatus bitOr: CastlingDisableQueenSide].
+ 		(move sourceSquare = 64) 
+ 			ifTrue:[^castlingStatus _ castlingStatus bitOr: CastlingDisableKingSide].
+ 	].!

Item was added:
+ ----- Method: ChessPlayer>>userAgent (in category 'accessing') -----
+ userAgent
+ 	^board userAgent!

Item was added:
+ Object subclass: #ChessPlayerAI
+ 	instanceVariableNames: 'board boardList boardListIndex player historyTable transTable generator random variations activeVariation bestVariation nodesVisited ttHits stamp alphaBetaCuts startTime ply myMove myProcess stopThinking bestMove'
+ 	classVariableNames: 'AlphaBetaGiveUp AlphaBetaIllegal AlphaBetaMaxVal AlphaBetaMinVal ValueAccurate ValueBoundary ValueLowerBound ValueThreshold ValueUpperBound'
+ 	poolDictionaries: 'ChessConstants'
+ 	category: 'Etoys-Squeakland-Morphic-Games-Chess'!
+ 
+ !ChessPlayerAI commentStamp: '<historical>' prior: 0!
+ I am the AI that will beat you eventually. Well, maybe not today ... BUT MY TIME WILL COME!!!!!!!

Item was added:
+ ----- Method: ChessPlayerAI class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"ChessPlayerAI initialize"
+ 	AlphaBetaGiveUp _ -29990.
+ 	AlphaBetaIllegal _ -31000.
+ 	AlphaBetaMaxVal _ 30000.
+ 	AlphaBetaMinVal _ -30000.
+ 	ValueAccurate _ 2.
+ 	ValueBoundary _ 4.
+ 	ValueLowerBound _ 4.
+ 	ValueUpperBound _ 5.
+ 	ValueThreshold _ 200.!

Item was added:
+ ----- Method: ChessPlayerAI>>activePlayer: (in category 'initialize') -----
+ activePlayer: aPlayer
+ 	player _ aPlayer.
+ 	board _ player board.
+ 	generator _ board generator.
+ 	self reset.!

Item was added:
+ ----- Method: ChessPlayerAI>>copyVariation: (in category 'searching') -----
+ copyVariation: move 
+ 	| av mv count |
+ 	count := 0.
+ 	av := variations at: ply + 1.
+ 	ply < 9 
+ 		ifTrue: 
+ 			[mv := variations at: ply + 2.
+ 			count := mv first.
+ 			av 
+ 				replaceFrom: 3
+ 				to: count + 2
+ 				with: mv
+ 				startingAt: 2].
+ 	av at: 1 put: count + 1.
+ 	av at: 2 put: move encodedMove!

Item was added:
+ ----- Method: ChessPlayerAI>>initialize (in category 'initialize') -----
+ initialize
+ 	historyTable _ ChessHistoryTable new.
+ 	"NOTE: transposition table is initialized only when we make the first move. It costs a little to do all the entries and the garbage collections so we do it only when we *really* need it."
+ 	transTable _ nil.
+ 	random _ Random new.
+ 	nodesVisited _ ttHits _ alphaBetaCuts _ stamp _ 0.
+ 	variations _ Array new: 11.
+ 	1 to: variations size do:[:i| 
+ 		variations at: i put: (Array new: variations size).
+ 		(variations at: i) atAllPut: 0].
+ 	bestVariation _ Array new: variations size.
+ 	bestVariation atAllPut: 0.
+ 	activeVariation _ Array new: variations size.
+ 	activeVariation atAllPut: 0.
+ 	self reset.!

Item was added:
+ ----- Method: ChessPlayerAI>>initializeTranspositionTable (in category 'initialize') -----
+ initializeTranspositionTable
+ 	"Initialize the transposition table. Note: For now we only use 64k entries since they're somewhat space intensive. If we should get a serious speedup at some point we may want to increase the transposition table - 256k seems like a good idea; but right now 256k entries cost us roughly 10MB of space. So we use only 64k entries (2.5MB of space).
+ 	If you have doubts about the size of the transition table (e.g., if you think it's too small or too big) then modify the value below and have a look at ChessTranspositionTable>>clear which can print out some valuable statistics.
+ 	"
+ 	transTable _ ChessTranspositionTable new: 16. "1 << 16 entries"!

Item was added:
+ ----- Method: ChessPlayerAI>>isThinking (in category 'thinking') -----
+ isThinking
+ 	^myProcess notNil!

Item was added:
+ ----- Method: ChessPlayerAI>>mtdfSearch:score:depth: (in category 'searching') -----
+ mtdfSearch: theBoard score: estimate depth: depth 
+ 	"An implementation of the MTD(f) algorithm. See:
+ 		http://www.cs.vu.nl/~aske/mtdf.html
+ 	"
+ 
+ 	| beta move value low high goodMove |
+ 	value := estimate.
+ 	low := AlphaBetaMinVal.
+ 	high := AlphaBetaMaxVal.
+ 	[low >= high] whileFalse: 
+ 			[beta := value = low ifTrue: [value + 1] ifFalse: [beta := value].
+ 			move := self 
+ 						searchMove: theBoard
+ 						depth: depth
+ 						alpha: beta - 1
+ 						beta: beta.
+ 			stopThinking ifTrue: [^move].
+ 			move ifNil: [^move].
+ 			value := move value.
+ 			value < beta 
+ 				ifTrue: [high := value]
+ 				ifFalse: 
+ 					["NOTE: It is important that we do *NOT* return a move from a search which didn't reach the beta goal (e.g., value < beta). This is because all it means is that we didn't reach beta and the move returned is not the move 'closest' to beta but just one that triggered cut-off. In other words, if we'd take a move which value is less than beta it could mean that this move is a *LOT* worse than beta."
+ 
+ 					low := value.
+ 					goodMove := move.
+ 					activeVariation 
+ 						replaceFrom: 1
+ 						to: activeVariation size
+ 						with: (variations first)
+ 						startingAt: 1]].
+ 	^goodMove!

Item was added:
+ ----- Method: ChessPlayerAI>>negaScout:depth:alpha:beta: (in category 'searching') -----
+ negaScout: theBoard depth: depth alpha: initialAlpha beta: initialBeta 
+ 	"Modified version to return the move rather than the score"
+ 	| move score alpha bestScore moveList newBoard beta goodMove a b notFirst |
+ 	self
+ 		assert: [initialAlpha < initialBeta].
+ 	ply < 10
+ 		ifTrue: [(variations at: ply + 1)
+ 				at: 1
+ 				put: 0].
+ 	ply _ 0.
+ 	alpha _ initialAlpha.
+ 	beta _ initialBeta.
+ 	bestScore _ AlphaBetaMinVal.
+ 	"Generate new moves"
+ 	moveList _ generator findPossibleMovesFor: theBoard activePlayer.
+ 	moveList
+ 		ifNil: [^ nil].
+ 	moveList size = 0
+ 		ifTrue: [generator recycleMoveList: moveList.
+ 			^ nil].
+ 	"Sort move list according to history heuristics"
+ 	moveList sortUsing: historyTable.
+ 	"And search"
+ 	a _ alpha.
+ 	b _ beta.
+ 	notFirst _ false.
+ 	[(move _ moveList next) isNil]
+ 		whileFalse: [newBoard _ (boardList at: ply + 1)
+ 						copyBoard: theBoard.
+ 			newBoard nextMove: move.
+ 			"Search recursively"
+ 			"Search recursively"
+ 			ply _ ply + 1.
+ 			score _ 0
+ 						- (self
+ 								ngSearch: newBoard
+ 								depth: depth - 1
+ 								alpha: 0 - b
+ 								beta: 0 - a).
+ 			(notFirst
+ 					and: [score > a
+ 							and: [score < beta
+ 									and: [depth > 1]]])
+ 				ifTrue: [score _ 0
+ 								- (self
+ 										ngSearch: newBoard
+ 										depth: depth - 1
+ 										alpha: 0 - beta
+ 										beta: 0 - score)].
+ 			notFirst _ true.
+ 			ply _ ply - 1.
+ 			stopThinking
+ 				ifTrue: [generator recycleMoveList: moveList.
+ 					^ move].
+ 			score = AlphaBetaIllegal
+ 				ifFalse: [score > bestScore
+ 						ifTrue: [ply < 10
+ 								ifTrue: [self copyVariation: move].
+ 							goodMove _ move copy.
+ 							goodMove value: score.
+ 							activeVariation
+ 								replaceFrom: 1
+ 								to: activeVariation size
+ 								with: variations first
+ 								startingAt: 1.
+ 							bestScore _ score].
+ 					"See if we can cut off the search"
+ 					score > a
+ 						ifTrue: [a _ score.
+ 							a >= beta
+ 								ifTrue: [transTable
+ 										storeBoard: theBoard
+ 										value: score
+ 										type: (ValueBoundary
+ 												bitOr: (ply bitAnd: 1))
+ 										depth: depth
+ 										stamp: stamp.
+ 									historyTable addMove: move.
+ 									alphaBetaCuts _ alphaBetaCuts + 1.
+ 									generator recycleMoveList: moveList.
+ 									^ goodMove]].
+ 					b _ a + 1]].
+ 	transTable
+ 		storeBoard: theBoard
+ 		value: bestScore
+ 		type: (ValueAccurate
+ 				bitOr: (ply bitAnd: 1))
+ 		depth: depth
+ 		stamp: stamp.
+ 	generator recycleMoveList: moveList.
+ 	^ goodMove!

Item was added:
+ ----- Method: ChessPlayerAI>>ngSearch:depth:alpha:beta: (in category 'searching') -----
+ ngSearch: theBoard depth: depth alpha: initialAlpha beta: initialBeta 
+ 	"A basic alpha-beta algorithm; based on negaMax rather than from the text books"
+ 
+ 	| move score alpha entry bestScore moveList newBoard beta a b notFirst |
+ 	self assert: [initialAlpha < initialBeta].
+ 	ply < 10 ifTrue: [(variations at: ply + 1) at: 1 put: 0].
+ 	depth = 0 
+ 		ifTrue: 
+ 			[^self 
+ 				quiesce: theBoard
+ 				alpha: initialAlpha
+ 				beta: initialBeta].
+ 	nodesVisited := nodesVisited + 1.
+ 	"See if there's already something in the transposition table. If so, skip the entire search."
+ 	entry := transTable lookupBoard: theBoard.
+ 	alpha := initialAlpha.
+ 	beta := initialBeta.
+ 	(entry isNil or: [entry depth < depth]) 
+ 		ifFalse: 
+ 			[ttHits := ttHits + 1.
+ 			(entry valueType bitAnd: 1) = (ply bitAnd: 1) 
+ 				ifTrue: [beta := entry value max: initialBeta]
+ 				ifFalse: [alpha := 0 - entry value max: initialAlpha].
+ 			beta > initialBeta ifTrue: [^beta].
+ 			alpha >= initialBeta ifTrue: [^alpha]].
+ 	bestScore := AlphaBetaMinVal.
+ 
+ 	"Generate new moves"
+ 	moveList := generator findPossibleMovesFor: theBoard activePlayer.
+ 	moveList ifNil: [^0 - AlphaBetaIllegal].
+ 	moveList isEmpty 
+ 		ifTrue: 
+ 			[generator recycleMoveList: moveList.
+ 			^bestScore].
+ 
+ 	"Sort move list according to history heuristics"
+ 	moveList sortUsing: historyTable.
+ 
+ 	"And search"
+ 	a := alpha.
+ 	b := beta.
+ 	notFirst := false.
+ 	[(move := moveList next) isNil] whileFalse: 
+ 			[newBoard := (boardList at: ply + 1) copyBoard: theBoard.
+ 			newBoard nextMove: move.
+ 			"Search recursively"
+ 			ply := ply + 1.
+ 			score := 0 - (self 
+ 								ngSearch: newBoard
+ 								depth: depth - 1
+ 								alpha: 0 - b
+ 								beta: 0 - a).
+ 			(notFirst and: [score > a and: [score < beta and: [depth > 1]]]) 
+ 				ifTrue: 
+ 					[score := 0 - (self 
+ 										ngSearch: newBoard
+ 										depth: depth - 1
+ 										alpha: 0 - beta
+ 										beta: 0 - score)].
+ 			notFirst := true.
+ 			ply := ply - 1.
+ 			stopThinking 
+ 				ifTrue: 
+ 					[generator recycleMoveList: moveList.
+ 					^score].
+ 			score = AlphaBetaIllegal 
+ 				ifFalse: 
+ 					[score > bestScore 
+ 						ifTrue: 
+ 							[ply < 10 ifTrue: [self copyVariation: move].
+ 							bestScore := score].
+ 					score > a 
+ 						ifTrue: 
+ 							[a := score.
+ 							a >= beta 
+ 								ifTrue: 
+ 									[transTable 
+ 										storeBoard: theBoard
+ 										value: score
+ 										type: (ValueBoundary bitOr: (ply bitAnd: 1))
+ 										depth: depth
+ 										stamp: stamp.
+ 									historyTable addMove: move.
+ 									alphaBetaCuts := alphaBetaCuts + 1.
+ 									generator recycleMoveList: moveList.
+ 									^score]].
+ 					b := a + 1]].
+ 	transTable 
+ 		storeBoard: theBoard
+ 		value: bestScore
+ 		type: (ValueAccurate bitOr: (ply bitAnd: 1))
+ 		depth: depth
+ 		stamp: stamp.
+ 	generator recycleMoveList: moveList.
+ 	^bestScore!

Item was added:
+ ----- Method: ChessPlayerAI>>quiesce:alpha:beta: (in category 'searching') -----
+ quiesce: theBoard alpha: initialAlpha beta: initialBeta 
+ 	"A variant of alpha-beta considering only captures and null moves to obtain a quiet position, e.g. one that is unlikely to change heavily in the very near future."
+ 
+ 	| move score alpha entry bestScore moveList newBoard beta |
+ 	self assert: [initialAlpha < initialBeta].
+ 	ply < 10 ifTrue: [(variations at: ply + 1) at: 1 put: 0].
+ 	nodesVisited := nodesVisited + 1.
+ 	"See if there's already something in the transposition table."
+ 	entry := transTable lookupBoard: theBoard.
+ 	alpha := initialAlpha.
+ 	beta := initialBeta.
+ 	entry isNil 
+ 		ifFalse: 
+ 			[ttHits := ttHits + 1.
+ 			(entry valueType bitAnd: 1) = (ply bitAnd: 1) 
+ 				ifTrue: [beta := entry value max: initialBeta]
+ 				ifFalse: [alpha := 0 - entry value max: initialAlpha].
+ 			beta > initialBeta ifTrue: [^beta].
+ 			alpha >= initialBeta ifTrue: [^alpha]].
+ 	ply < 2 
+ 		ifTrue: 
+ 			["Always generate moves if ply < 2 so that we don't miss a move that
+ 		would bring the king under attack (e.g., make an invalid move)."
+ 
+ 			moveList := generator findQuiescenceMovesFor: theBoard activePlayer.
+ 			moveList ifNil: [^0 - AlphaBetaIllegal]].
+ 
+ 	"Evaluate the current position, assuming that we have a non-capturing move."
+ 	bestScore := theBoard activePlayer evaluate.
+ 	"TODO: What follows is clearly not the Right Thing to do. The score we just evaluated doesn't take into account that we may be under attack at this point. I've seen it happening various times that the static evaluation triggered a cut-off which was plain wrong in the position at hand.
+ 	There seem to be three ways to deal with the problem. #1 is just deepen the search. If we go one ply deeper we will most likely find the problem (although that's not entirely certain). #2 is to improve the evaluator function and make it so that the current evaluator is only an estimate saying if it's 'likely' that a non-capturing move will do. The more sophisticated evaluator should then take into account which pieces are under attack. Unfortunately that could make the AI play very passive, e.g., avoiding situations where pieces are under attack even if these attacks are outweighed by other factors. #3 would be to insert a null move here to see *if* we are under attack or not (I've played with this) but for some reason the resulting search seemed to explode rapidly. I'm uncertain if that's due to the transposition table being too small (I don't *really* think so but it may be) or if I've just got something else wrong."
+ 	bestScore > alpha 
+ 		ifTrue: 
+ 			[alpha := bestScore.
+ 			bestScore >= beta 
+ 				ifTrue: 
+ 					[moveList ifNotNil: [generator recycleMoveList: moveList].
+ 					^bestScore]].
+ 
+ 	"Generate new moves"
+ 	moveList ifNil: 
+ 			[moveList := generator findQuiescenceMovesFor: theBoard activePlayer.
+ 			moveList ifNil: [^0 - AlphaBetaIllegal]].
+ 	moveList isEmpty 
+ 		ifTrue: 
+ 			[generator recycleMoveList: moveList.
+ 			^bestScore].
+ 
+ 	"Sort move list according to history heuristics"
+ 	moveList sortUsing: historyTable.
+ 
+ 	"And search"
+ 	[(move := moveList next) isNil] whileFalse: 
+ 			[newBoard := (boardList at: ply + 1) copyBoard: theBoard.
+ 			newBoard nextMove: move.
+ 			"Search recursively"
+ 			ply := ply + 1.
+ 			score := 0 - (self 
+ 								quiesce: newBoard
+ 								alpha: 0 - beta
+ 								beta: 0 - alpha).
+ 			stopThinking 
+ 				ifTrue: 
+ 					[generator recycleMoveList: moveList.
+ 					^score].
+ 			ply := ply - 1.
+ 			score = AlphaBetaIllegal 
+ 				ifFalse: 
+ 					[score > bestScore 
+ 						ifTrue: 
+ 							[ply < 10 ifTrue: [self copyVariation: move].
+ 							bestScore := score].
+ 					"See if we can cut off the search"
+ 					score > alpha 
+ 						ifTrue: 
+ 							[alpha := score.
+ 							score >= beta 
+ 								ifTrue: 
+ 									[transTable 
+ 										storeBoard: theBoard
+ 										value: score
+ 										type: (ValueBoundary bitOr: (ply bitAnd: 1))
+ 										depth: 0
+ 										stamp: stamp.
+ 									historyTable addMove: move.
+ 									alphaBetaCuts := alphaBetaCuts + 1.
+ 									generator recycleMoveList: moveList.
+ 									^bestScore]]]].
+ 	transTable 
+ 		storeBoard: theBoard
+ 		value: bestScore
+ 		type: (ValueAccurate bitOr: (ply bitAnd: 1))
+ 		depth: 0
+ 		stamp: stamp.
+ 	generator recycleMoveList: moveList.
+ 	^bestScore!

Item was added:
+ ----- Method: ChessPlayerAI>>reset (in category 'initialize') -----
+ reset
+ 	transTable ifNotNil:[transTable clear].
+ 	historyTable clear.
+ !

Item was added:
+ ----- Method: ChessPlayerAI>>reset: (in category 'initialize') -----
+ reset: aBoard
+ 	self reset.
+ 	boardList ifNil:[
+ 		boardList _ Array new: 100.
+ 		1 to: boardList size do:[:i| boardList at: i put: (aBoard copy userAgent: nil)].
+ 		boardListIndex _ 0].
+ 	board _ aBoard.!

Item was added:
+ ----- Method: ChessPlayerAI>>search:depth:alpha:beta: (in category 'searching') -----
+ search: theBoard depth: depth alpha: initialAlpha beta: initialBeta 
+ 	"A basic alpha-beta algorithm; based on negaMax rather than from the text books"
+ 
+ 	| move score alpha entry bestScore moveList newBoard beta |
+ 	self assert: [initialAlpha < initialBeta].
+ 	ply < 10 ifTrue: [(variations at: ply + 1) at: 1 put: 0].
+ 	depth = 0 
+ 		ifTrue: 
+ 			[^self 
+ 				quiesce: theBoard
+ 				alpha: initialAlpha
+ 				beta: initialBeta].
+ 	nodesVisited := nodesVisited + 1.
+ 	"See if there's already something in the transposition table. If so, skip the entire search."
+ 	entry := transTable lookupBoard: theBoard.
+ 	alpha := initialAlpha.
+ 	beta := initialBeta.
+ 	(entry isNil or: [entry depth < depth]) 
+ 		ifFalse: 
+ 			[ttHits := ttHits + 1.
+ 			(entry valueType bitAnd: 1) = (ply bitAnd: 1) 
+ 				ifTrue: [beta := entry value max: initialBeta]
+ 				ifFalse: [alpha := 0 - entry value max: initialAlpha].
+ 			beta > initialBeta ifTrue: [^beta].
+ 			alpha >= initialBeta ifTrue: [^alpha]].
+ 	bestScore := AlphaBetaMinVal.
+ 
+ 	"Generate new moves"
+ 	moveList := generator findPossibleMovesFor: theBoard activePlayer.
+ 	moveList ifNil: [^0 - AlphaBetaIllegal].
+ 	moveList isEmpty 
+ 		ifTrue: 
+ 			[generator recycleMoveList: moveList.
+ 			^bestScore].
+ 
+ 	"Sort move list according to history heuristics"
+ 	moveList sortUsing: historyTable.
+ 
+ 	"And search"
+ 	[(move := moveList next) isNil] whileFalse: 
+ 			[newBoard := (boardList at: ply + 1) copyBoard: theBoard.
+ 			newBoard nextMove: move.
+ 			"Search recursively"
+ 			ply := ply + 1.
+ 			score := 0 - (self 
+ 								search: newBoard
+ 								depth: depth - 1
+ 								alpha: 0 - beta
+ 								beta: 0 - alpha).
+ 			stopThinking 
+ 				ifTrue: 
+ 					[generator recycleMoveList: moveList.
+ 					^score].
+ 			ply := ply - 1.
+ 			score = AlphaBetaIllegal 
+ 				ifFalse: 
+ 					[score > bestScore 
+ 						ifTrue: 
+ 							[ply < 10 ifTrue: [self copyVariation: move].
+ 							bestScore := score].
+ 					"See if we can cut off the search"
+ 					score > alpha 
+ 						ifTrue: 
+ 							[alpha := score.
+ 							score >= beta 
+ 								ifTrue: 
+ 									[transTable 
+ 										storeBoard: theBoard
+ 										value: score
+ 										type: (ValueBoundary bitOr: (ply bitAnd: 1))
+ 										depth: depth
+ 										stamp: stamp.
+ 									historyTable addMove: move.
+ 									alphaBetaCuts := alphaBetaCuts + 1.
+ 									generator recycleMoveList: moveList.
+ 									^bestScore]]]].
+ 	transTable 
+ 		storeBoard: theBoard
+ 		value: bestScore
+ 		type: (ValueAccurate bitOr: (ply bitAnd: 1))
+ 		depth: depth
+ 		stamp: stamp.
+ 	generator recycleMoveList: moveList.
+ 	^bestScore!

Item was added:
+ ----- Method: ChessPlayerAI>>searchMove:depth:alpha:beta: (in category 'searching') -----
+ searchMove: theBoard depth: depth alpha: initialAlpha beta: initialBeta 
+ 	"Modified version to return the move rather than the score"
+ 
+ 	| move score alpha bestScore moveList newBoard beta goodMove |
+ 	self assert: [initialAlpha < initialBeta].
+ 	ply < 10 ifTrue: [(variations at: ply + 1) at: 1 put: 0].
+ 	ply := 0.
+ 	alpha := initialAlpha.
+ 	beta := initialBeta.
+ 	bestScore := AlphaBetaMinVal.
+ 
+ 	"Generate new moves"
+ 	moveList := generator findPossibleMovesFor: theBoard activePlayer.
+ 	moveList ifNil: [^nil].
+ 	moveList isEmpty 
+ 		ifTrue: 
+ 			[generator recycleMoveList: moveList.
+ 			^nil].
+ 
+ 	"Sort move list according to history heuristics"
+ 	moveList sortUsing: historyTable.
+ 
+ 	"And search"
+ 	[(move := moveList next) isNil] whileFalse: 
+ 			[newBoard := (boardList at: ply + 1) copyBoard: theBoard.
+ 			newBoard nextMove: move.
+ 			"Search recursively"
+ 			ply := ply + 1.
+ 			score := 0 - (self 
+ 								search: newBoard
+ 								depth: depth - 1
+ 								alpha: 0 - beta
+ 								beta: 0 - alpha).
+ 			stopThinking 
+ 				ifTrue: 
+ 					[generator recycleMoveList: moveList.
+ 					^move].
+ 			ply := ply - 1.
+ 			score = AlphaBetaIllegal 
+ 				ifFalse: 
+ 					[score > bestScore 
+ 						ifTrue: 
+ 							[ply < 10 ifTrue: [self copyVariation: move].
+ 							goodMove := move copy.
+ 							goodMove value: score.
+ 							bestScore := score].
+ 					"See if we can cut off the search"
+ 					score > alpha 
+ 						ifTrue: 
+ 							[alpha := score.
+ 							score >= beta 
+ 								ifTrue: 
+ 									[transTable 
+ 										storeBoard: theBoard
+ 										value: score
+ 										type: (ValueBoundary bitOr: (ply bitAnd: 1))
+ 										depth: depth
+ 										stamp: stamp.
+ 									historyTable addMove: move.
+ 									alphaBetaCuts := alphaBetaCuts + 1.
+ 									generator recycleMoveList: moveList.
+ 									^goodMove]]]].
+ 	transTable 
+ 		storeBoard: theBoard
+ 		value: bestScore
+ 		type: (ValueAccurate bitOr: (ply bitAnd: 1))
+ 		depth: depth
+ 		stamp: stamp.
+ 	generator recycleMoveList: moveList.
+ 	^goodMove!

Item was added:
+ ----- Method: ChessPlayerAI>>startThinking (in category 'thinking') -----
+ startThinking
+ 	self isThinking ifTrue:[^self].
+ 	self activePlayer: board activePlayer.
+ 	self thinkStep.!

Item was added:
+ ----- Method: ChessPlayerAI>>statusString (in category 'nil') -----
+ statusString
+ 	| av count |
+ 	^String streamContents:[:s|
+ 		(myMove == #none or:[myMove == nil]) ifFalse:[
+ 			s print: myMove value * 0.01; space.
+ 		].
+ 		av _ bestVariation.
+ 		count _ av at: 1.
+ 		count > 0 ifFalse:[
+ 			av _ activeVariation.
+ 			count _ av at: 1].
+ 		count > 0 ifFalse:[
+ 			s nextPutAll:'***'.
+ 			av _ variations at: 1.
+ 			count _ av at: 1.
+ 			count > 3 ifTrue:[count _ 3]].
+ 		2 to: count + 1 do:[:index|
+ 			s nextPutAll: (ChessMove decodeFrom: (av at: index)) moveString.
+ 			s space].
+ 
+ 		s nextPut:$[.
+ 		s print: nodesVisited.
+ "		s nextPut:$|.
+ 		s print: ttHits.
+ 		s nextPut: $|.
+ 		s print: alphaBetaCuts.
+ "		s nextPut:$].
+ 
+ 	].!

Item was added:
+ ----- Method: ChessPlayerAI>>think (in category 'thinking') -----
+ think
+ 	| move |
+ 	self isThinking ifTrue: [^nil].
+ 	self startThinking.
+ 	[(move := self thinkStep) isNil] whileTrue.
+ 	^move!

Item was added:
+ ----- Method: ChessPlayerAI>>thinkProcess (in category 'thinking') -----
+ thinkProcess
+ 	| score theMove depth |
+ 	stopThinking := false.
+ 	score := board activePlayer evaluate.
+ 	depth := 1.
+ 	stamp := stamp + 1.
+ 	ply := 0.
+ 	historyTable clear.
+ 	transTable clear.
+ 	startTime := Time millisecondClockValue.
+ 	nodesVisited := ttHits := alphaBetaCuts := 0.
+ 	bestVariation at: 1 put: 0.
+ 	activeVariation at: 1 put: 0.
+ 	[nodesVisited < 50000] whileTrue: 
+ 			["whats this ? (aoy)  false ifTrue:[] ????!!"
+ 
+ 			theMove := false 
+ 						ifTrue: 
+ 							[self 
+ 								mtdfSearch: board
+ 								score: score
+ 								depth: depth]
+ 						ifFalse: 
+ 							[self 
+ 								negaScout: board
+ 								depth: depth
+ 								alpha: AlphaBetaMinVal
+ 								beta: AlphaBetaMaxVal].
+ 			theMove ifNil: [^myProcess := nil].
+ 			stopThinking ifTrue: [^myProcess := nil].
+ 			myMove := theMove.
+ 			bestVariation 
+ 				replaceFrom: 1
+ 				to: bestVariation size
+ 				with: activeVariation
+ 				startingAt: 1.
+ 			score := theMove value.
+ 			depth := depth + 1].
+ 	myProcess := nil!

Item was added:
+ ----- Method: ChessPlayerAI>>thinkStep (in category 'thinking') -----
+ thinkStep
+ 	transTable ifNil: [self initializeTranspositionTable].
+ 	myProcess isNil 
+ 		ifTrue: 
+ 			[myMove := #none.
+ 			false 
+ 				ifTrue: 
+ 					[self thinkProcess.
+ 					^myMove].
+ 			myProcess := [self thinkProcess] forkAt: Processor userBackgroundPriority.
+ 			myProcess suspend.
+ 			^nil].
+ 	myProcess resume.
+ 	(Delay forMilliseconds: 50) wait.
+ 	myProcess ifNil: [^myMove == #none ifTrue: [nil] ifFalse: [myMove]].
+ 	myProcess suspend.
+ 	"Do we have a valid move?"
+ 	myMove == #none ifTrue: [^nil].	"no"
+ 	"Did we time out?"
+ 	Time millisecondClockValue - startTime > self timeToThink 
+ 		ifTrue: 
+ 			["Yes. Abort and return current move."
+ 
+ 			stopThinking := true.
+ 			myProcess resume.
+ 			[myProcess isNil] whileFalse: [(Delay forMilliseconds: 10) wait].
+ 			^myMove == #none ifTrue: [nil] ifFalse: [myMove]].
+ 	"Keep thinking"
+ 	^nil!

Item was added:
+ ----- Method: ChessPlayerAI>>timeToThink (in category 'thinking') -----
+ timeToThink
+ 	"Return the number of milliseconds we're allowed to think"
+ 	^5000!

Item was added:
+ Object subclass: #ChessTTEntry
+ 	instanceVariableNames: 'value valueType depth hashLock timeStamp'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games-Chess'!
+ 
+ !ChessTTEntry commentStamp: '<historical>' prior: 0!
+ This class represents an entry in the transposition table, storing the value (plus some maintenance information) of some position.!

Item was added:
+ ----- Method: ChessTTEntry>>clear (in category 'accessing') -----
+ clear
+ 	value _ valueType _ timeStamp _ depth _ -1.!

Item was added:
+ ----- Method: ChessTTEntry>>depth (in category 'accessing') -----
+ depth
+ 	^depth!

Item was added:
+ ----- Method: ChessTTEntry>>depth: (in category 'accessing') -----
+ depth: aNumber
+ 	depth _ aNumber!

Item was added:
+ ----- Method: ChessTTEntry>>hashLock (in category 'accessing') -----
+ hashLock
+ 	^hashLock!

Item was added:
+ ----- Method: ChessTTEntry>>hashLock: (in category 'accessing') -----
+ hashLock: aNumber
+ 	hashLock _ aNumber!

Item was added:
+ ----- Method: ChessTTEntry>>timeStamp (in category 'accessing') -----
+ timeStamp
+ 	^timeStamp!

Item was added:
+ ----- Method: ChessTTEntry>>timeStamp: (in category 'accessing') -----
+ timeStamp: aNumber
+ 	timeStamp _ aNumber!

Item was added:
+ ----- Method: ChessTTEntry>>value (in category 'accessing') -----
+ value
+ 	^value!

Item was added:
+ ----- Method: ChessTTEntry>>value: (in category 'accessing') -----
+ value: newValue
+ 	value _ newValue!

Item was added:
+ ----- Method: ChessTTEntry>>valueType (in category 'accessing') -----
+ valueType
+ 	^valueType!

Item was added:
+ ----- Method: ChessTTEntry>>valueType: (in category 'accessing') -----
+ valueType: newType
+ 	valueType _ newType!

Item was added:
+ Object subclass: #ChessTranspositionTable
+ 	instanceVariableNames: 'array used collisions'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games-Chess'!
+ 
+ !ChessTranspositionTable commentStamp: '<historical>' prior: 0!
+ The transposition table is a lookup cache for positions in a game that occur through transpositions in move. As an example, the same position is obtained by the moves:
+ 	1. e2-e4		Nb8-c6
+ 	2. d2-d4
+ and
+ 	1. d2-d4		Nb8-c6
+ 	2. e2-e4
+ An extremely large number of search branches can be cut off immediately by recognizing that the current position is just the transposition of another one. The transposition table is one of the techniques that actually make modern chess programs good enough to compete with or even beat humans.
+ !

Item was added:
+ ----- Method: ChessTranspositionTable class>>new: (in category 'instance creation') -----
+ new: bits
+ 	^self basicNew initialize: bits!

Item was added:
+ ----- Method: ChessTranspositionTable>>clear (in category 'initialize') -----
+ clear
+ 	"Set the following to true for printing information about the fill rate and number of collisions. The transposition table should have *plenty* of free space (it should rarely exceed 30% fill rate) and *very* few collisions (those require us to evaluate positions repeatedly that we've evaluated before -- bad idea!!)"
+ 
+ 	| entry |
+ 	false 
+ 		ifTrue: 
+ 			[used position > 0 
+ 				ifTrue: 
+ 					['entries used:	' , used position printString , ' (' 
+ 						, (used position * 100 // array size) printString , '%)	' 
+ 						displayAt: 0 @ 0].
+ 			collisions > 0 
+ 				ifTrue: 
+ 					['collisions:		' , collisions printString , ' (' 
+ 						, (collisions * 100 // array size) printString , '%)	' 
+ 						displayAt: 0 @ 15]].
+ 	used position: 0.
+ 	[(entry := used next) isNil] whileFalse: [entry clear].
+ 	used resetToStart.
+ 	collisions := 0!

Item was added:
+ ----- Method: ChessTranspositionTable>>initialize: (in category 'initialize') -----
+ initialize: nBits
+ 	"Initialize the receiver using 1<<nBits entries. See also ChessPlayerAI>>initializeTranspositionTable."
+ 	| entry |
+ 	array _ Array new: 1 << nBits.
+ 	used _ ReadWriteStream on: (Array new: 50000). "<- will grow if not sufficient!!"
+ 	entry _ ChessTTEntry new clear.
+ 	1 to: array size do:[:i| array at: i put: entry clone].
+ 	collisions _ 0.
+ 	Smalltalk garbageCollect. "We *really* want them old here"!

Item was added:
+ ----- Method: ChessTranspositionTable>>lookupBoard: (in category 'lookup') -----
+ lookupBoard: aBoard
+ 	| key entry |
+ 	key _ aBoard hashKey bitAnd: array size - 1.
+ 	entry _ array at: key + 1.
+ 	entry ifNil:[^nil].
+ 	entry valueType = -1 ifTrue:[^nil].
+ 	entry hashLock = aBoard hashLock ifFalse:[^nil].
+ 	^entry!

Item was added:
+ ----- Method: ChessTranspositionTable>>storeBoard:value:type:depth:stamp: (in category 'initialize') -----
+ storeBoard: aBoard value: value type: valueType depth: depth stamp: timeStamp
+ 	| key entry |
+ 	key _ aBoard hashKey bitAnd: array size - 1.
+ 	entry _ array at: key + 1.
+ 	entry valueType = -1 
+ 		ifTrue:[used nextPut: entry]
+ 		ifFalse:[entry hashLock = aBoard hashLock ifFalse:[collisions _ collisions + 1]].
+ 	(entry valueType = -1 
+ 		or:[entry depth <= depth
+ 		or:[entry timeStamp < timeStamp]]) ifFalse:[^self].
+ 	entry hashLock: aBoard hashLock.
+ 	entry value: value.
+ 	entry valueType: valueType.
+ 	entry depth: depth.
+ 	entry timeStamp: timeStamp.
+ !

Item was added:
+ EllipseMorph subclass: #ChineseCheckerPiece
+ 	instanceVariableNames: 'boardLoc myBoard'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!
+ 
+ !ChineseCheckerPiece commentStamp: '<historical>' prior: 0!
+ I represent a player piece for Chinese Checkers.  Mostly I act as an ellipse, but my special methods ensure that I cannot be picked up or dropped except in the proper circumstances.
+ 
+ Structure:
+  myBoard		a ChineseCheckers morph
+  boardLoc		my current logical position on the board.
+ !

Item was added:
+ ----- Method: ChineseCheckerPiece class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 
+ 	^ false!

Item was added:
+ ----- Method: ChineseCheckerPiece>>boardLoc (in category 'accessing') -----
+ boardLoc
+ 
+ 	^ boardLoc!

Item was added:
+ ----- Method: ChineseCheckerPiece>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: evt
+ 
+ 	^ true!

Item was added:
+ ----- Method: ChineseCheckerPiece>>justDroppedInto:event: (in category 'dropping/grabbing') -----
+ justDroppedInto: newOwner event: evt
+ 
+ 	newOwner == myBoard ifFalse:
+ 		["Only allow dropping into my board."
+ 		^self rejectDropMorphEvent: evt].
+ 	^super justDroppedInto: newOwner event: evt!

Item was added:
+ ----- Method: ChineseCheckerPiece>>mouseDown: (in category 'event handling') -----
+ mouseDown: evt
+ 
+ 	((owner isKindOf: ChineseCheckers)
+ 		and: [owner okToPickUpPieceAt: boardLoc])
+ 		ifTrue: [evt hand grabMorph: self]!

Item was added:
+ ----- Method: ChineseCheckerPiece>>setBoard:loc: (in category 'accessing') -----
+ setBoard: aBoard loc: aBoardLoc
+ 
+ 	myBoard _ aBoard.
+ 	boardLoc _ aBoardLoc!

Item was added:
+ BorderedMorph subclass: #ChineseCheckers
+ 	instanceVariableNames: 'board sixDeltas teams homes autoPlay whoseMove plannedMove plannedMovePhase colors movePhase animateMoves pathMorphs'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!
+ 
+ !ChineseCheckers commentStamp: '<historical>' prior: 0!
+ An implementation of Chinese Checkers by Dan Ingalls.  April 9, 2000.
+ 
+ board:  A 19x19 rhombic array, addressed by row at col points, in which is imbedded the familiar six-pointed layout of cells.  A cell outside the board is nil (-).
+   - - - - - - - - - - - - - - - - - - -
+    - - - - - - - - - - - - - 5 - - - - -
+     - - - - - - - - - - - - 5 5 - - - - -
+      - - - - - - - - - - - 5 5 5 - - - - -
+       - - - - - - - - - - 5 5 5 5 - - - - -
+        - - - - - 6 6 6 6 0 0 0 0 0 4 4 4 4 -
+         - - - - - 6 6 6 0 0 0 0 0 0 4 4 4 - -
+          - - - - - 6 6 0 0 0 0 0 0 0 4 4 - - -
+           - - - - - 6 0 0 0 0 0 0 0 0 4 - - - -
+            - - - - - 0 0 0 0 0 0 0 0 0 - - - - -
+             - - - - 1 0 0 0 0 0 0 0 0 3 - - - - -
+              - - - 1 1 0 0 0 0 0 0 0 3 3 - - - - -
+               - - 1 1 1 0 0 0 0 0 0 3 3 3 - - - - -
+                - 1 1 1 1 0 0 0 0 0 3 3 3 3 - - - - -
+                 - - - - - 2 2 2 2 - - - - - - - - - -
+                  - - - - - 2 2 2 - - - - - - - - - - -
+                   - - - - - 2 2 - - - - - - - - - - - -
+                    - - - - - 2 - - - - - - - - - - - - -
+                     - - - - - - - - - - - - - - - - - - -
+ Cells within the board contain 0 if empty, or a team number (1..6) if occupied by a piece of that team.  An extra border of nils around the whole reduces bounds checking to a nil test.
+ 
+ sixDeltas:  An array giving the x at y deltas for the 6 valid steps in CCW order from a given cell.  For team 1 they are: in fr, fl, l, bl, br, r.  To get, eg fl for a given team, use (sixDeltas atWrap: team+1).
+ 
+ teams:  An array of six teams, each of which is an array of the x at y locations of the 10 pieces.
+ 
+ homes:  The x at y coordinates of the six home points, namely 14 at 2, 18 at 6, 14 at 14, 6 at 18, 2 at 14, 6 at 6.  The goal, or farthest point in destination triangle, is thus (homes atWrap: teamNo+3).
+ 
+ autoPlay:  An array of booleans, parallel to teams, where true means that Squeak will make the moves for the corresponding team.
+ 
+ whoseMove:  A team number specifying whose turn it is next.  Set to 0 when game is over.
+ 
+ plannedMove:  If not nil, it means the board is in a state where it is animating the next move to be made so that it can be seen.
+ 
+ movePhase:  Holds the state of display of the planned move so that, eg, it can appear one jump at a time.  Advances from 1 to (plannedMove size * 2).
+ 
+ A move is an array of locs which are the path of the move.
+ 
+ Once the morph is open, the menu command 'reset...' allows you to reset the board and change the number of players.  The circle at turnIndicatorLoc indicates the color of the team whose turn it is.  If it is a human, play waits for drag and drop of a piece of that color.
+ 
+ The current strategy is very simple: generate all moves, score them and pick the best.  Beyond this, it will look ahead a number of moves, but this becomes very expensive without pruning.  Pruning would help the speed of play, especially in the end game where we look a little deeper.  A more effective strategy would consider opponents' possible moves as well, but this is left as an exercise for the serious programmer.!

Item was added:
+ ----- Method: ChineseCheckers class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName:	'ChineseCheckers' translatedNoop
+ 		categories:		{'Games' translatedNoop}
+ 		documentation:	'Halma - the classic board game of Chinese Checkers, written by Dan Ingalls' translatedNoop!

Item was added:
+ ----- Method: ChineseCheckers>>acceptDroppingMorph:event: (in category 'layout') -----
+ acceptDroppingMorph: aPiece event: evt
+ 
+ 	| dropLoc |
+ 	dropLoc _ self boardLocAt: evt cursorPoint.
+ 	dropLoc = aPiece boardLoc ifTrue:  "Null move"
+ 		[^ aPiece rejectDropMorphEvent: evt].
+ 	(plannedMove _ (self allMovesFrom: aPiece boardLoc)
+ 				detect: [:move | move last = dropLoc]
+ 				ifNone: [nil])
+ 		ifNil: [^ aPiece rejectDropMorphEvent: evt.   "Not a valid move"].
+ 
+ 	super acceptDroppingMorph: aPiece event: evt.
+ 	movePhase _ 1.  "Start the animation if any."
+ !

Item was added:
+ ----- Method: ChineseCheckers>>addCustomMenuItems:hand: (in category 'menus') -----
+ addCustomMenuItems: aCustomMenu hand: aHandMorph
+ 	"Include our modest command set in the ctrl-menu"
+ 
+ 	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ 	aCustomMenu addLine.
+ 	self addMenuItemsTo: aCustomMenu hand: aHandMorph!

Item was added:
+ ----- Method: ChineseCheckers>>addMenuItemsTo:hand: (in category 'menu') -----
+ addMenuItemsTo: aMenu hand: aHandMorph
+ 
+ 	aMenu add: 'new game' translated target: self action: #newGame.
+ 	aMenu add: 'reset...' translated target: self action: #reset.
+ 	animateMoves
+ 		ifTrue: [aMenu add: 'don''t animate moves' translated target: self action: #dontAnimateMoves]
+ 		ifFalse: [aMenu add: 'animate moves' translated target: self action: #animateMoves]
+ 
+ !

Item was added:
+ ----- Method: ChineseCheckers>>allMovesFrom: (in category 'moves') -----
+ allMovesFrom: boardLoc  "boardLoc must be occupied"
+ 	| team stepMoves jumpDict |
+ 	team := self at: boardLoc.
+ 	stepMoves := (sixDeltas collect: [:d | boardLoc + d])
+ 		select: [:p | (self at: p) notNil and: [(self at: p) = 0]].
+ 	jumpDict := Dictionary new.
+ 	jumpDict at: boardLoc put: (Array with: boardLoc).
+ 	self jumpFor: team from: boardLoc havingVisited: jumpDict.
+ 	jumpDict removeKey: boardLoc.
+ 	^ (stepMoves collect: [:p | {boardLoc. p}]) , jumpDict values
+ 		reject:
+ 		[:move |  "Don't include any moves that land in other homes."
+ 		(self distFrom: move last to: self boardCenter) >= 5  "In a home..."
+ 			and: [(self distFrom: move last to: (homes atWrap: team+3)) > 3  "...not my goal..."
+ 			and: [(self distFrom: move last to: (homes at: team)) > 3  "...nor my home"]]]!

Item was added:
+ ----- Method: ChineseCheckers>>animateMoves (in category 'menu') -----
+ animateMoves
+ 
+ 	animateMoves _ true!

Item was added:
+ ----- Method: ChineseCheckers>>at: (in category 'accessing') -----
+ at: p
+ 	^ (board at: p x) at: p y!

Item was added:
+ ----- Method: ChineseCheckers>>at:put: (in category 'accessing') -----
+ at: p put: x
+ 	^ (board at: p x) at: p y put: x!

Item was added:
+ ----- Method: ChineseCheckers>>bestMove:forTeam: (in category 'moves') -----
+ bestMove: ply forTeam: team
+ 	| score bestScore bestMove |
+ 	bestScore := -999.
+ 	(teams at: team) do:
+ 		[:boardLoc |
+ 		(self allMovesFrom: boardLoc) do:
+ 			[:move |
+ 			score := self score: move for: team.
+ 			(score > -99 and: [ply > 0]) ifTrue: 
+ 				[score := score  "Add 0.7 * score of next move (my guess)"
+ 					+ (0 max: ((self score: ((self copyBoard makeMove: move)
+ 							bestMove: ply - 1 forTeam: team) for: team) * 0.7))].
+ 			score > bestScore ifTrue:
+ 				[bestScore := score.  bestMove := move]]].
+ 	^ bestMove!

Item was added:
+ ----- Method: ChineseCheckers>>board:teams: (in category 'initialization') -----
+ board: b teams: t
+ 	board := b.
+ 	teams := t!

Item was added:
+ ----- Method: ChineseCheckers>>boardCenter (in category 'board geometry') -----
+ boardCenter
+ 	^ 10 at 10!

Item was added:
+ ----- Method: ChineseCheckers>>boardLocAt: (in category 'board geometry') -----
+ boardLocAt: cellPoint
+ 
+ 	| dx dy row col |
+ 	dx _ self width/15.0.  dy _ dx * 0.8660254037844385 "(Float pi / 3) sin".
+ 	row _ (cellPoint y - self position y) // dy + 1.
+ 	col _ (cellPoint x - self position x) / (dx/2.0) + 16 - row // 2.
+ 	^ row @ col!

Item was added:
+ ----- Method: ChineseCheckers>>cellPointAt: (in category 'board geometry') -----
+ cellPointAt: boardLoc
+ 	| dx dy row col |
+ 	dx _ self width/15.0.  dy _ dx * 0.8660254037844385 "(Float pi / 3) sin".
+ 	row _ boardLoc x.
+ 	col _ boardLoc y.
+ 	^ self position + ((col*2+row-16*dx//2)@(row-1*dy)) asIntegerPoint!

Item was added:
+ ----- Method: ChineseCheckers>>checkDoneAfter: (in category 'moves') -----
+ checkDoneAfter: move
+ 
+ 	| team locsAfterMove |
+ 	(team := self at: move first) = 0 ifTrue: [^ false].
+ 	(locsAfterMove _ (teams at: team) copy) replaceAll: move first with: move last.
+ 	^ self testDone: locsAfterMove for: team!

Item was added:
+ ----- Method: ChineseCheckers>>copyBoard (in category 'initialization') -----
+ copyBoard
+ 	"Return a copy of the board for the purpose of looking ahead one or more moves."
+ 
+ 	^ self copy
+ 		board: (board collect: [:row | row copy])
+ 		teams: (teams collect: [:team | team copy])!

Item was added:
+ ----- Method: ChineseCheckers>>defaultColor (in category 'initialization') -----
+ defaultColor
+ "answer the default color/fill style for the receiver"
+ 	^ Color
+ 		r: 0.6
+ 		g: 0.4
+ 		b: 0.0!

Item was added:
+ ----- Method: ChineseCheckers>>distFrom:to: (in category 'board geometry') -----
+ distFrom: a to: b
+ 	"The six possible moves are: 1 at 0, 1 at -1, 0 at 1, 0 at -1, -1 at 0, -1 at 1."
+ 	| dx dy |
+ 	dx _ b x - a x.
+ 	dy _ b y - a y.
+ 	dx abs >= dy abs
+ 	ifTrue: ["Major change is in x-coord..."
+ 			dx >= 0
+ 			ifTrue: [(dy between: (0-dx) and: 0)
+ 						ifTrue: [^ dx  "no lateral motion"].
+ 					^ dx + ((0-dx) - dy max: dy - 0)  "added lateral dist"]
+ 			ifFalse: ["Reverse sign and rerun same code"
+ 					^ self distFrom: b to: a]]
+ 	ifFalse: ["Transpose and re-run same code"
+ 			^ self distFrom: a transposed to: b transposed]!

Item was added:
+ ----- Method: ChineseCheckers>>dontAnimateMoves (in category 'menu') -----
+ dontAnimateMoves
+ 
+ 	animateMoves _ false!

Item was added:
+ ----- Method: ChineseCheckers>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas 
+ 
+ 	| row1 row2 offset dotExtent |
+ 	super drawOn: aCanvas.   "Draw square board"
+ 
+ 	"Only draw rows in the clipping region"
+ 	dotExtent _ (self width//25) asPoint.
+ 	offset _ self pieceSize - dotExtent + 1 // 2.  "Offset of smaller dots rel to larger"
+ 	row1 _ (self boardLocAt: aCanvas clipRect topLeft) x max: 1.
+ 	row2 _ (self boardLocAt: aCanvas clipRect bottomRight) x min: board size.
+ 	row1 to: row2 do:
+ 		[:row | (board at: row) doWithIndex:
+ 			[:cell :i | cell ifNotNil:
+ 				[aCanvas fillOval: ((self cellPointAt: (row at i)) + offset extent: dotExtent)
+ 					color: (colors at: cell+1)]]]!

Item was added:
+ ----- Method: ChineseCheckers>>endGameFor: (in category 'moves') -----
+ endGameFor: team
+ 	"Return true if we are in the end game (all players within 1 of home triangle)."
+ 
+ 	| goalLoc |
+ 	goalLoc _ homes atWrap: team+3.  "Farthest cell across the board"
+ 	(teams at: team)
+ 		do: [:boardLoc | (self distFrom: boardLoc to: goalLoc) > 4 ifTrue: [^ false]].
+ 	^ true!

Item was added:
+ ----- Method: ChineseCheckers>>extent: (in category 'geometry') -----
+ extent: newExtent
+ 
+ 	| extraY |
+ 	extraY _ (newExtent x / 15.0 * 1.25) asInteger.
+ 	super extent: (newExtent x) @ (newExtent x + extraY).
+ 	self submorphsDo:
+ 		[:m | (m isKindOf: ChineseCheckerPiece) ifTrue:
+ 				[m position: (self cellPointAt: m boardLoc); extent: self pieceSize]]!

Item was added:
+ ----- Method: ChineseCheckers>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: evt
+ 	"Prevent stray clicks from picking up the whole game in MVC."
+ 
+ 	^ Smalltalk isMorphic not or: [evt yellowButtonPressed]!

Item was added:
+ ----- Method: ChineseCheckers>>initialize (in category 'initialization') -----
+ initialize
+ 	"Default creation is for one person against Squeak."
+ 	super initialize.
+ 	""
+ 	self extent: 382 @ 413.
+ 
+ 	animateMoves _ true.
+ 	self teams: #(2 5 ) autoPlay: {false. true}!

Item was added:
+ ----- Method: ChineseCheckers>>initializeToStandAlone (in category 'parts bin') -----
+ initializeToStandAlone 
+ 	"Default creation is for one person against Squeak."
+ 
+ 	super initializeToStandAlone.
+ 	self extent: 382 at 413.
+ 	self color: (Color r: 0.6 g: 0.4 b: 0.0).
+ 	self borderWidth: 2.
+ 	animateMoves _ true.
+ 	self teams: #(2 5) autoPlay: {false. true}.
+ !

Item was added:
+ ----- Method: ChineseCheckers>>jumpFor:from:havingVisited: (in category 'moves') -----
+ jumpFor: team from: loc havingVisited: dict
+ 	"Recursively explore all jumps from loc, leaving in dict
+ 	the prior position from which we got there"
+ 
+ 	"Fasten seatbelts..."
+ 	((((sixDeltas
+ 		collect: [:d | loc + d])
+ 		select: [:p | (self at: p) notNil and: [(self at: p) > 0]])
+ 		collect: [:p | p + (p - loc)])
+ 		select: [:p | (self at: p) notNil and: [(self at: p) = 0]])
+ 		do: [:p | (dict includesKey: p) ifFalse:
+ 			[dict at: p put: ((dict at: loc) copyWith: p).
+ 			self jumpFor: team from: p havingVisited: dict]]!

Item was added:
+ ----- Method: ChineseCheckers>>makeMove: (in category 'moves') -----
+ makeMove: move
+ 	| team |
+ 	team := self at: move first.
+ 	self at: move last put: team.
+ 	self at: move first put: 0.
+ 	(teams at: team) replaceAll: move first with: move last!

Item was added:
+ ----- Method: ChineseCheckers>>mouseDown: (in category 'event handling') -----
+ mouseDown: evt
+ 
+ 	| menu |
+ 	evt yellowButtonPressed ifFalse: [^ self].
+ 	menu _ MenuMorph new defaultTarget: self.
+ 	self addMenuItemsTo: menu hand: evt hand.
+ 	menu popUpEvent: evt in: self world.
+ !

Item was added:
+ ----- Method: ChineseCheckers>>newGame (in category 'menu') -----
+ newGame
+ 	"Reset the board, with same teams."
+ 
+ 	| teamNumbers |
+ 	teamNumbers _ (1 to: 6) reject: [:i | (teams at: i) isEmpty].
+ 	self teams: teamNumbers
+ 		 autoPlay: (teamNumbers collect: [:i | autoPlay at: i]).
+ !

Item was added:
+ ----- Method: ChineseCheckers>>nextTurn (in category 'game sequence') -----
+ nextTurn
+ 
+ 	(self testDone: (teams at: whoseMove) for: whoseMove) ifTrue:
+ 		[(self pieceAt: self turnIndicatorLoc) extent: self width asPoint//6; borderWidth: 2.
+ 		^ whoseMove _ 0.  "Game over."].	
+ 
+ 	[whoseMove _ whoseMove\\6 + 1.
+ 	(teams at: whoseMove) isEmpty]  "Turn passes to the next player"
+ 		whileTrue: [].
+ 	(self pieceAt: self turnIndicatorLoc) color: (colors at: whoseMove+1)!

Item was added:
+ ----- Method: ChineseCheckers>>okToPickUpPieceAt: (in category 'drag and drop') -----
+ okToPickUpPieceAt: boardLoc
+ 
+ 	^ (self at: boardLoc) = whoseMove and: [(autoPlay at: whoseMove) not]!

Item was added:
+ ----- Method: ChineseCheckers>>pieceAt: (in category 'drag and drop') -----
+ pieceAt: boardLoc
+ 
+ 	self submorphsDo:
+ 		[:m | ((m isMemberOf: ChineseCheckerPiece) and: [m boardLoc = boardLoc])
+ 				ifTrue: [^ m]].
+ 	^ nil!

Item was added:
+ ----- Method: ChineseCheckers>>pieceSize (in category 'board geometry') -----
+ pieceSize
+ 
+ 	^ self width asPoint // 20!

Item was added:
+ ----- Method: ChineseCheckers>>printOn: (in category 'printing') -----
+ printOn: s 
+ 	"For testing only"
+ 
+ 	1 to: board size
+ 		do: 
+ 			[:row | 
+ 			s
+ 				cr;
+ 				next: row put: $ .
+ 			(board at: row) do: 
+ 					[:cell | 
+ 					s
+ 						space;
+ 						nextPut: (cell isNil ifTrue: [$-] ifFalse: [cell printString last])]]!

Item was added:
+ ----- Method: ChineseCheckers>>reset (in category 'menu') -----
+ reset
+ 	"Reset the board, choosing anew how many teams."
+ 
+ 	| nPlayers nHumans |
+ 	nPlayers _ (SelectionMenu 
+ 					selections: (1 to: 6)) 
+ 					startUpWithCaption: 'How many players?' translated.
+ 	nPlayers ifNil: [nPlayers _ 2].
+ 	nHumans _ (SelectionMenu 
+ 					selections: (0 to: nPlayers)) 
+ 					startUpWithCaption: 'How many humans?' translated.
+ 	nHumans ifNil: [nHumans _ 1].
+ 	self teams: (#((1) (2 5) (2 4 6) (1 2 4 5) (1 2 3 4 6) (1 2 3 4 5 6)) at: nPlayers)
+ 		 autoPlay: ((1 to: nPlayers) collect: [:i | i > nHumans]).
+ !

Item was added:
+ ----- Method: ChineseCheckers>>score:for: (in category 'moves') -----
+ score: move for: team
+ 	"Return the decrease in distance toward this team's goal"
+ 
+ 	| goal closerToGoal wasBack nowBack |
+ 	goal _ homes atWrap: team+3.
+ 	wasBack _ self distFrom: move first to: goal.
+ 	nowBack _ self distFrom: move last to: goal.
+ 	closerToGoal _ wasBack - nowBack.
+ 	closerToGoal < -1 ifTrue: [^ -99].  "Quick rejection if move backward more than 1"
+ 	(nowBack <= 3 and: [self checkDoneAfter: move]) ifTrue: [^ 999].
+ 	"Reward closerToGoal, but add bias to move those left far behind."
+ 	^ (closerToGoal*5) + wasBack!

Item was added:
+ ----- Method: ChineseCheckers>>showNextMoveSegment (in category 'game sequence') -----
+ showNextMoveSegment
+ 	"Display the current move in progress.  Starts with movePhase = 1.
+ 	Increments movePhase at each tick.  Ends by setting movePhase to 0."
+ 
+ 	| dot p1 p2 delta secondPhase line |
+ 	delta _ self width//40.
+ 	movePhase <= plannedMove size
+ 	ifTrue:
+ 		["First we trace the move with dots and lines..."
+ 		movePhase = 1 ifTrue: [pathMorphs _ OrderedCollection new].
+ 		p1 _ self cellPointAt: (plannedMove at: movePhase).
+ 		dot _ (ImageMorph new image: (Form dotOfSize: 7)) position: p1 + delta - (7//2).
+ 		self addMorph: dot.  pathMorphs addLast: dot.
+ 		movePhase > 1 ifTrue:
+ 			[p2 _ self cellPointAt: (plannedMove at: movePhase-1).
+ 			line _ PolygonMorph vertices: {p2 + delta. p1 + delta} color: Color black
+ 					borderWidth: 3 borderColor: Color black.
+ 			self addMorph: line.  pathMorphs addLast: line]]
+ 	ifFalse:
+ 		["...then we erase the path while moving the piece."
+ 		secondPhase _ movePhase - plannedMove size.
+ 		pathMorphs removeFirst delete.
+ 		secondPhase > 1 ifTrue:
+ 			[pathMorphs removeFirst delete.
+ 			self makeMove: {plannedMove at: secondPhase - 1. plannedMove at: secondPhase}.
+ 			(self pieceAt: (plannedMove at: secondPhase - 1))
+ 				position: (self cellPointAt: (plannedMove at: secondPhase));
+ 				setBoard: self loc: (plannedMove at: secondPhase).
+ 			self changed]].
+ 
+ 	(movePhase _ movePhase + 1) > (plannedMove size * 2)
+ 		ifTrue: [movePhase _ 0  "End of animated move"].
+ 
+ !

Item was added:
+ ----- Method: ChineseCheckers>>step (in category 'game sequence') -----
+ step
+ 	whoseMove = 0 ifTrue: [^self].	"Game over."
+ 	plannedMove isNil 
+ 		ifTrue: 
+ 			[(autoPlay at: whoseMove) ifFalse: [^self].	"Waiting for a human."
+ 			plannedMove := (self endGameFor: whoseMove) 
+ 						ifTrue: 
+ 							["Look deeper at the end."
+ 
+ 							self bestMove: 2 forTeam: whoseMove]
+ 						ifFalse: [self bestMove: 1 forTeam: whoseMove].
+ 			movePhase := 1	"Start the animated move"].
+ 	animateMoves 
+ 		ifTrue: 
+ 			["Display the move in phases..."
+ 
+ 			movePhase > 0 ifTrue: [^self showNextMoveSegment]]
+ 		ifFalse: 
+ 			["... or skip the entire animated move if requested."
+ 
+ 			self makeMove: plannedMove.
+ 			(self pieceAt: plannedMove first)
+ 				position: (self cellPointAt: plannedMove last);
+ 				setBoard: self loc: plannedMove last.
+ 			self changed.
+ 			movePhase := 0].
+ 	plannedMove := nil.	"End the animated move"
+ 	self nextTurn!

Item was added:
+ ----- Method: ChineseCheckers>>stepTime (in category 'testing') -----
+ stepTime
+ 
+ 	^ 200!

Item was added:
+ ----- Method: ChineseCheckers>>teams:autoPlay: (in category 'initialization') -----
+ teams: teamsPlaying autoPlay: ifAuto
+ 	"Initialize board, teams, steps, jumps"
+ 	| p q teamInPlay |
+ 	colors _ (#(gray) , #(red green blue cyan magenta yellow white) shuffled)
+ 				collect: [:c | Color perform: c].  "New set of colors each time."
+ 	self removeAllMorphs.  "eg, from previous game."
+ 	board := (1 to: 19) collect: [:i | Array new: 19].
+ 	sixDeltas := {0 at 1. -1 at 1. -1 at 0. 0 at -1. 1 at -1. 1 at 0}.
+ 	homes := {14 at 2. 18 at 6. 14 at 14. 6 at 18. 2 at 14. 6 at 6}.
+ 	teams := (1 to: 6) collect: [:i | OrderedCollection new].
+ 	autoPlay := (1 to: 6) collect: [:i | false].
+ 	1 to: 6 do:
+ 		[:team | p:= homes at: team.
+ 		(teamInPlay := teamsPlaying includes: team) ifTrue:
+ 			[autoPlay at: team put: (ifAuto at: (teamsPlaying indexOf: team))].
+ 		"Place empty cells in rhombus extending out from each
+ 		home, and occupied cells in active home triangles."
+ 		1 to: 5 do: [:i | q := p.
+ 			1 to: 5 do: [:j |
+ 				(teamInPlay and: [j <= (5 - i)])
+ 					ifTrue: [self at: q put: team.
+ 							(teams at: team) add: q.
+ 							self addMorph:
+ 								((ChineseCheckerPiece
+ 									newBounds: ((self cellPointAt: q) extent: self pieceSize)
+ 									color: (colors at: team+1))
+ 										setBoard: self loc: q)]
+ 					ifFalse: [self at: q put: 0].
+ 				q := q + (sixDeltas at: team).  "right,forward"].
+ 			p := p + (sixDeltas atWrap: team+1).  "left,forward"].
+ 		teams at: team put: (teams at: team) asArray].
+ 	whoseMove _ teamsPlaying first.
+ 	self addMorph:
+ 		((ChineseCheckerPiece
+ 			newBounds: ((self cellPointAt: self turnIndicatorLoc) extent: self pieceSize)
+ 			color: (colors at: whoseMove+1))
+ 				setBoard: self loc: self turnIndicatorLoc).
+ 	plannedMove _ nil.
+ 	self changed!

Item was added:
+ ----- Method: ChineseCheckers>>testDone:for: (in category 'moves') -----
+ testDone: teamLocs for: team
+ 	"Return true if we are done (all players in home triangle)."
+ 
+ 	| goalLoc |
+ 	goalLoc _ homes atWrap: team+3.
+ 	teamLocs
+ 		do: [:boardLoc | (self distFrom: boardLoc to: goalLoc) > 3 ifTrue: [^ false]].
+ 	^ true!

Item was added:
+ ----- Method: ChineseCheckers>>turnIndicatorLoc (in category 'board geometry') -----
+ turnIndicatorLoc
+ 
+ 	^ 16 at 11!

Item was added:
+ ----- Method: ChineseCheckers>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
+ wantsDroppedMorph: aPiece event: evt
+ 
+ 	^ aPiece isKindOf: ChineseCheckerPiece
+ !

Item was added:
+ WordGamePanelMorph subclass: #CipherPanel
+ 	instanceVariableNames: 'originalText quote originalMorphs decodingMorphs'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!
+ 
+ !CipherPanel commentStamp: '<historical>' prior: 0!
+ The CipherPanel, as its name suggests, is a tool for decoding simple substitution codes, such as are presented on the puzzle pages of many Sunday newspapers.  Most of the capability is inherited from the two WordGame classes used.  To try it out, choose newMorph/Games/CipherPanel in a morphic project, or execute, in any project:
+ 
+ 	CipherPanel new openInWorld
+ !

Item was added:
+ ----- Method: CipherPanel class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName:	'Cipher' translatedNoop
+ 		categories:		{'Games' translatedNoop}
+ 		documentation:	'The Cipher Panel: A playground for cryptograms, by Dan Ingalls' translatedNoop!

Item was added:
+ ----- Method: CipherPanel class>>encode: (in category 'as yet unclassified') -----
+ encode: aString
+ 	"CipherPanel encode: 'Now is the time for all good men to come to the aid of their country.'"
+ 
+ 	| dict repeat |
+ 	dict _ Dictionary new.
+ 	repeat _ true.
+ 	[repeat] whileTrue:
+ 		[repeat _ false.
+ 		($A to: $Z) with: ($A to: $Z) shuffled do:
+ 			[:a :b | a = b ifTrue: [repeat _ true].
+ 			dict at: a put: b]].
+ 	^ aString asUppercase collect: [:a | dict at: a ifAbsent: [a]]!

Item was added:
+ ----- Method: CipherPanel class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 
+ 	^ true!

Item was added:
+ ----- Method: CipherPanel class>>new (in category 'instance creation') -----
+ new
+ 	"NOTE: Use newFromQuote: rather than new to create new CipherPanels"
+ 
+ 	^ self newFromQuote: self sampleString
+ 
+ " Here are some other examples...
+ World addMorph: (CipherPanel newFromQuote: 'BPFFXY LZY PK ROY RPBY PG XPAY HOYG EJCM SXJROYK FJG''R APR QCR PR''K EJC HOJ GYYF ROY LXRYMLRPJGK.  KJCMSY CGNGJHG')
+ 
+ World addMorph: (CipherPanel newFromQuote: 'Y FRV TRK HJRH QVL QS HJL BPLRHLTH WZLRTXPLT YV ZYSL YT OQYVB MJRH WLQWZL TRK KQX FRVVQH OQ.')
+ 
+ World addMorph: (CipherPanel newFromQuote: 'XI''H SAZRG: SDCIZCIZT EZDEAZ TD CDI SGZRIZ EGDPGZHH.')
+ 
+ World addMorph: (CipherPanel newFromQuote: 'PY MOJ WPMMWJ MZGYR ZL MOJ GZSWH PM''R YZ RZZYJS HZYJ MOBY RBPH.')
+ 
+ World addMorph: (CipherPanel newFromQuote: 'PYSLHYA DJP VBHHLXYAA BPY BGNBMA PLUVQ LX AQMGY; QVY HPLXSLHBG LXUPYCLYXQA BPY NBPK BXC DPLYXCGM AKLGYA.')
+ 
+ World addMorph: (CipherPanel newFromQuote: 'U HWVS RJ AHOST RLO FOOQOST TJUSM AJIO LOVNC WUXRUSM VST HWVCUSM LVSTZVWW. -- TVNUT WORROEIVS VXROE LUA KGUSRGHWO-ZCHVAA LOVER JHOEVRUJS')
+ "!

Item was added:
+ ----- Method: CipherPanel class>>newFromQuote: (in category 'as yet unclassified') -----
+ newFromQuote: encodedString
+ 	"Use this to creat new panels instead of new."
+ 
+ 	^ super new encodedQuote: encodedString!

Item was added:
+ ----- Method: CipherPanel class>>randomComment (in category 'as yet unclassified') -----
+ randomComment
+ 	"CipherPanel randomComment"
+ 	"Generate cryptic puzzles from method comments in the system"
+ 	| c s |
+ 	s := 'none'.
+ 	[s = 'none']
+ 		whileTrue: [s := ((c := SystemNavigation new allClasses atRandom) selectors
+ 						collect: [:sel | (c firstCommentAt: sel) asString])
+ 						detect: [:str | str size between: 100 and: 200]
+ 						ifNone: ['none' translated]].
+ 	^ s!

Item was added:
+ ----- Method: CipherPanel class>>sampleString (in category 'as yet unclassified') -----
+ sampleString
+ 	^
+ 'E SGJC OSCVC LICGNV, ENGRCV, JEVEMAV. E SGJC OSEV QGVVEMA XMI [SMWWDHMML] ... EO''V HMALCIXKW OM SGJC VMNCOSEAR OSGO EAVQEICV GAL LIEJCV DMK. -- ZGIZIG VOICEVGAL'!

Item was added:
+ ----- Method: CipherPanel class>>tedsHack (in category 'as yet unclassified') -----
+ tedsHack  
+ 	"Generate cryptic puzzles from method comments in the system"
+ 	(self newFromQuote: (self encode: (self randomComment))) openInWorld
+ 
+ "CipherPanel tedsHack"!

Item was added:
+ ----- Method: CipherPanel>>addMenuItemsTo:hand: (in category 'menu') -----
+ addMenuItemsTo: aMenu hand: aHandMorph 
+ 	aMenu
+ 		add: 'show cipher help' translated
+ 		target: self
+ 		action: #showHelpWindow.
+ 	aMenu
+ 		add: 'show cipher hints' translated
+ 		target: self
+ 		action: #showHintsWindow.
+ 	aMenu
+ 		add: 'clear cipher typing' translated
+ 		target: self
+ 		action: #clearTyping.
+ 	aMenu
+ 		add: 'enter a new cipher' translated
+ 		target: self
+ 		action: #enterANewCipher.
+ 	aMenu
+ 		add: 'quote from Squeak' translated
+ 		target: self
+ 		action: #squeakCipher!

Item was added:
+ ----- Method: CipherPanel>>buttonRow (in category 'menu') -----
+ buttonRow
+ 	| row aButton |
+ 	row := AlignmentMorph newRow color: self color;
+ 				 hResizing: #shrinkWrap;
+ 				 vResizing: #shrinkWrap.
+ 	#('show help' 'show hints' 'clear typing' 'enter a new cipher' 'quote from Squeak' ) translatedNoop
+ 		with: #(#showHelpWindow #showHintsWindow #clearTyping #enterANewCipher #squeakCipher )
+ 		do: [:label :selector | 
+ 			aButton := SimpleButtonMorph new target: self.
+ 			aButton color: Color transparent;
+ 				 borderWidth: 1;
+ 				 borderColor: Color black.
+ 			aButton actionSelector: selector.
+ 			aButton label: label translated.
+ 			row addMorphBack: aButton.
+ 			row addTransparentSpacerOfSize: 3 @ 0].
+ 	^ row!

Item was added:
+ ----- Method: CipherPanel>>cipherStats (in category 'menu') -----
+ cipherStats
+ 
+ 	| letterCounts digraphs d digraphCounts |
+ 	letterCounts _ (quote copyWithout: Character space) asBag sortedCounts.
+ 	digraphs _ Bag new.
+ 	quote withIndexDo:
+ 		[:c :i |
+ 		i < quote size ifTrue:
+ 			[d _ quote at: i+1.
+ 			(c ~= Character space and: [d ~= Character space]) ifTrue:
+ 				[digraphs add: (String with: c with: d)]]].
+ 	digraphCounts _ digraphs sortedCounts.
+ 	^ String streamContents:
+ 		[:strm |
+ 		1 to: 10 do:
+ 			[:i |
+ 			strm cr; tab; nextPut: (letterCounts at: i) value.
+ 			strm tab; print: (letterCounts at: i) key.
+ 			(digraphCounts at: i) key > 1 ifTrue:
+ 				[strm tab; tab; tab; nextPutAll: (digraphCounts at: i) value.
+ 				strm tab; print: (digraphCounts at: i) key]]]!

Item was added:
+ ----- Method: CipherPanel>>clearTyping (in category 'defaults') -----
+ clearTyping
+ 	self isClean
+ 		ifTrue: [^ self].
+ 	(self confirm: 'Are you sure you want to discard all typing?' translated)
+ 		ifFalse: [^ self].
+ 	super clearTyping!

Item was added:
+ ----- Method: CipherPanel>>encodedQuote: (in category 'initialization') -----
+ encodedQuote: aString 
+ 	"World addMorph: CipherPanel new"
+ 	| morph prev |
+ 	aString isEmpty
+ 		ifTrue: [^ self].
+ 	(letterMorphs isNil
+ 			or: [self isClean])
+ 		ifFalse: [(self confirm: 'Are you sure you want to discard all typing?' translated)
+ 				ifFalse: [^ self]].
+ 	haveTypedHere := false.
+ 	quote := aString asUppercase.
+ 	prev := nil.
+ 	originalMorphs := quote asArray
+ 				collectWithIndex: [:c :i | WordGameLetterMorph new plain indexInQuote: i id1: nil;
+ 						
+ 						setLetter: (quote at: i)].
+ 	letterMorphs := OrderedCollection new.
+ 	decodingMorphs := quote asArray
+ 				collectWithIndex: [:c :i | (quote at: i) isLetter
+ 						ifTrue: [morph := WordGameLetterMorph new underlined indexInQuote: i id1: nil.
+ 							morph
+ 								on: #mouseDown
+ 								send: #mouseDownEvent:letterMorph:
+ 								to: self.
+ 							morph
+ 								on: #keyStroke
+ 								send: #keyStrokeEvent:letterMorph:
+ 								to: self.
+ 							letterMorphs addLast: morph.
+ 							morph predecessor: prev.
+ 							prev
+ 								ifNotNil: [prev successor: morph].
+ 							prev := morph]
+ 						ifFalse: [WordGameLetterMorph new plain indexInQuote: i id1: nil;
+ 								
+ 								setLetter: (quote at: i)]].
+ 	self color: originalMorphs first color.
+ 	self extent: 500 @ 500!

Item was added:
+ ----- Method: CipherPanel>>enterANewCipher (in category 'menu') -----
+ enterANewCipher
+ 	self clearTyping;
+ 		encodedQuote: (FillInTheBlank request: 'Type a cipher text to work on here below...' translated)!

Item was added:
+ ----- Method: CipherPanel>>extent: (in category 'geometry') -----
+ extent: newExtent 
+ 	"Lay out with word wrap, alternating bewteen decoded and encoded lines."
+ 	"Currently not tolerant of narrow (less than a word) margins"
+ 
+ 	| w h relLoc topLeft thisWord i m corner row firstWord |
+ 	self removeAllMorphs.
+ 	w _ originalMorphs first width - 1.  h _ originalMorphs first height * 2 + 10.
+ 	topLeft _ self position + self borderWidth + (0 at 10).
+ 	thisWord _ OrderedCollection new.
+ 	i _ 1.  firstWord _ true.  relLoc _ 0 at 0.  corner _ topLeft.
+ 	[i <= originalMorphs size] whileTrue:
+ 		[m _ originalMorphs at: i.
+ 		thisWord addLast: ((decodingMorphs at: i) position: topLeft + relLoc).
+ 		thisWord addLast: (m position: topLeft + relLoc + (0 at m height)).
+ 		(m letter = Character space or: [i = originalMorphs size])
+ 			ifTrue: [self addAllMorphs: thisWord.
+ 					corner _ corner max: thisWord last bounds bottomRight.
+ 					thisWord reset.  firstWord _ false].
+ 		relLoc _ relLoc + (w at 0).
+ 		(relLoc x + w) > newExtent x
+ 			ifTrue: [firstWord
+ 						ifTrue: ["No spaces -- force a line break"
+ 								thisWord removeLast; removeLast.
+ 								self addAllMorphs: thisWord.
+ 								corner _ corner max: thisWord last bounds bottomRight]
+ 						ifFalse: [i _ i - (thisWord size//2) + 1].
+ 					thisWord reset.  firstWord _ true.
+ 					relLoc _ 0@(relLoc y + h)]
+ 			ifFalse: [i _ i + 1]].
+ 	row _ self buttonRow. row fullBounds.
+ 	self addMorph: row.
+ 	super extent: (corner - topLeft) + (self borderWidth * 2) + (0 at row height+10).
+ 	row align: row bounds bottomCenter with: self bounds bottomCenter - (0 at 2).!

Item was added:
+ ----- Method: CipherPanel>>initializeToStandAlone (in category 'parts bin') -----
+ initializeToStandAlone 
+ 	super initializeToStandAlone.
+ 	self encodedQuote: self class sampleString!

Item was added:
+ ----- Method: CipherPanel>>keyCharacter:atIndex:nextFocus: (in category 'defaults') -----
+ keyCharacter: aLetter atIndex: indexInQuote nextFocus: nextFocus
+ 
+ 	| encodedLetter |
+ 	encodedLetter _ quote at: indexInQuote.
+ 	originalMorphs with: decodingMorphs do:
+ 		[:e :d | e letter = encodedLetter ifTrue: [d setLetter: aLetter color: Color red]].
+ !

Item was added:
+ ----- Method: CipherPanel>>showHelpWindow (in category 'menu') -----
+ showHelpWindow
+ 	((StringHolder new contents: 'The Cipher Panel displays an encrypted message.  The encryption is a simple substitution code;  each letter of the alphabet has been changed to a different one.
+ 
+ You can solve the cipher by clicking above any letter in the message, and typing the letter you think it should be.  The Cipher Panel automatically makes the same substitution anywhere else that letter occurs in the encoded message.
+ 
+ If you are having trouble, you can use the command menu to ''show cipher hints''.  That will display how many of each letter occurs, which is often a help in solving ciphers.' translated)
+ 		embeddedInMorphicWindowLabeled: 'About the Cipher Panel' translated)
+ 		setWindowColor: (Color
+ 				r: 1.0
+ 				g: 0.6
+ 				b: 0.0);
+ 		 openInWorld: self world extent: 389 @ 209!

Item was added:
+ ----- Method: CipherPanel>>showHintsWindow (in category 'menu') -----
+ showHintsWindow
+ 	((StringHolder new contents: 'Most bodies of english text follow a general pattern of letter usage.  The following are the most common letters, in approximate order of frequency:
+ 	E  T  A  O  N  I  R  S  H
+ The following are the most common digraphs:
+ 	EN  ER  RE  NT  TH  ON  IN
+ 
+ The message you are trying to decode has the following specific statistics:' translated , self cipherStats , '
+ 
+ Good luck!!' translated)
+ 		embeddedInMorphicWindowLabeled: 'Some Useful Statistics' translated)
+ 		setWindowColor: (Color
+ 				r: 1.0
+ 				g: 0.6
+ 				b: 0.0);
+ 		 openInWorld: self world extent: 318 @ 326!

Item was added:
+ ----- Method: CipherPanel>>squeakCipher (in category 'menu') -----
+ squeakCipher
+ 	self encodedQuote: (CipherPanel encode: (CipherPanel randomComment))!

Item was added:
+ ----- Method: Class>>addInstVarNames: (in category '*Etoys-Squeakland-instance variables') -----
+ addInstVarNames: aCollection
+ 
+ 	| newInstVarString |
+ 	newInstVarString _ self instanceVariablesString.
+ 	aCollection do: 
+ 		[:varName | (self instVarNames includes: varName) ifFalse: [newInstVarString _ newInstVarString , ' ' , varName]].
+ 	^(ClassBuilder new)
+ 		name: self name
+ 		inEnvironment: self environment
+ 		subclassOf: superclass
+ 		type: self typeOfClass
+ 		instanceVariableNames: newInstVarString
+ 		classVariableNames: self classVariablesString
+ 		poolDictionaries: self sharedPoolsString
+ 		category: self category
+ !

Item was added:
+ ----- Method: Class>>removeInstVarNames: (in category '*Etoys-Squeakland-instance variables') -----
+ removeInstVarNames: aCollection 
+ 
+ 	| newInstVarString |
+ 	aCollection do: [:aString |
+ 		(self instVarNames includes: aString)
+ 			ifFalse: [self error: aString , ' is not one of my instance variables'].
+ 	].
+ 	newInstVarString _ ''.
+ 	(self instVarNames copyWithoutAll: aCollection) do: 
+ 		[:varName | newInstVarString _ newInstVarString , ' ' , varName].
+ 	^(ClassBuilder new)
+ 		name: self name
+ 		inEnvironment: self environment
+ 		subclassOf: superclass
+ 		type: self typeOfClass
+ 		instanceVariableNames: newInstVarString
+ 		classVariableNames: self classVariablesString
+ 		poolDictionaries: self sharedPoolsString
+ 		category: self category
+ !

Item was added:
+ ----- Method: ClassDescription>>category (in category '*Etoys-Squeakland-organization') -----
+ category
+ 	"Answer the system organization category for the receiver."
+ 
+ 	^SystemOrganization categoryOfElement: self name!

Item was added:
+ ----- Method: ClassDescription>>compile:classified:withStamp:notifying:logSource:for: (in category '*Etoys-Squeakland-compiling') -----
+ compile: text classified: category withStamp: changeStamp notifying: requestor logSource: logSource for: anInstance
+ 	| methodAndNode |
+ 	methodAndNode _ self basicCompile: text asString notifying: requestor 
+ 							trailer: self defaultMethodTrailer ifFail: [^nil] for: anInstance.
+ 	methodAndNode method: (methodAndNode method copyWithTempNames: (methodAndNode node tempNames)).
+ 	logSource ifTrue: [
+ 		self logMethodSource: text forMethodWithNode: methodAndNode 
+ 			inCategory: category withStamp: changeStamp notifying: requestor.
+ 	].
+ 	self addAndClassifySelector: methodAndNode selector withMethod: methodAndNode 
+ 		method inProtocol: category notifying: requestor.
+ 	self theNonMetaClass noteCompilationOf: methodAndNode selector meta: self isMeta.
+ 	^ methodAndNode selector!

Item was added:
+ ----- Method: ClassDescription>>compileSilently:classified:for: (in category '*Etoys-Squeakland-compiling') -----
+ compileSilently: code classified: category for: anInstance
+ 	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."
+ 
+ 	^ self compileSilently: code classified: category notifying: nil for: anInstance!

Item was added:
+ ----- Method: ClassDescription>>compileSilently:classified:notifying:for: (in category '*Etoys-Squeakland-compiling') -----
+ compileSilently: code classified: category notifying: requestor for: anInstance
+ 	"Compile the code and classify the resulting method in the given category, leaving no trail in the system log, nor in any change set, nor in the 'recent submissions' list. This should only be used when you know for sure that the compilation will succeed."
+ 
+ 	^ SystemChangeNotifier uniqueInstance 
+ 		doSilently: [self compile: code classified: category withStamp: nil notifying: requestor logSource: false for: anInstance].!

Item was added:
+ ----- Method: ClassDescription>>theNonMetaClassName (in category '*Etoys-Squeakland-accessing') -----
+ theNonMetaClassName
+ 
+ 	^self name.
+ !

Item was added:
+ ----- Method: Clipboard>>delete (in category '*Etoys-Squeakland-accessing') -----
+ delete
+ 	"Cleanup only internal buffer, but external"
+ 	contents _ '' asText!

Item was added:
+ TextMorph subclass: #ClipboardMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Widgets'!
+ 
+ !ClipboardMorph commentStamp: '<historical>' prior: 0!
+ A morph that always displays the current contents of the text clipboard.!

Item was added:
+ ----- Method: ClipboardMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName:	'Clipboard' translatedNoop
+ 		categories:		#()
+ 		documentation:	'This object will always show whatever is on the text clipboard' translatedNoop!

Item was added:
+ ----- Method: ClipboardMorph>>defaultBorderColor (in category 'initialization') -----
+ defaultBorderColor
+ 	"answer the default border color/fill style for the receiver"
+ 	^ Color
+ 		r: 1.0
+ 		g: 0.355
+ 		b: 0.452!

Item was added:
+ ----- Method: ClipboardMorph>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ 	"answer the default border width for the receiver"
+ 	^ 6!

Item was added:
+ ----- Method: ClipboardMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color blue!

Item was added:
+ ----- Method: ClipboardMorph>>initializeToStandAlone (in category 'parts bin') -----
+ initializeToStandAlone
+ 	super initializeToStandAlone.
+ ""
+ 	self initialize.
+ 	""
+ 	self extent: 200 @ 100.
+ 	self
+ 		backgroundColor: (Color
+ 				r: 0.484
+ 				g: 1.0
+ 				b: 0.484).
+ 	self setBalloonText: 'This shows the current contents of the text clipboard'.
+ 	self newContents: Clipboard clipboardText!

Item was added:
+ ----- Method: ClipboardMorph>>step (in category 'stepping and presenter') -----
+ step
+ 	self newContents: Clipboard clipboardText!

Item was added:
+ ----- Method: ClipboardMorph>>stepTime (in category 'testing') -----
+ stepTime
+ 	"Answer the interval between steps -- in this case a leisurely 1 seconds"
+ 
+ 	^ 1000!

Item was added:
+ ----- Method: ClipboardMorph>>wantsSteps (in category 'testing') -----
+ wantsSteps
+ 	^ true!

Item was added:
+ ----- Method: ClockMorph>>displaying24HourString (in category '*Etoys-Squeakland-menu') -----
+ displaying24HourString
+ 	"Answer a string characterizing whether the receiver is currently displaying in 24-hour mode, so that for example 2 pm will show as '14:00."
+ 
+ 	^ (show24hr == true ifTrue: ['<yes>'] ifFalse: ['<no>']), ('display 24-hour' translated)!

Item was added:
+ ----- Method: ClockMorph>>showingSecondsString (in category '*Etoys-Squeakland-menu') -----
+ showingSecondsString
+ 	"Answer a string characterizing whether the receiver is currently showing seconds."
+ 
+ 	^ (showSeconds == true ifTrue: ['<yes>'] ifFalse: ['<no>']), ('show seconds' translated)!

Item was added:
+ Object variableSubclass: #ClosureEnvironment
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Kernel-Contexts'!
+ 
+ !ClosureEnvironment commentStamp: 'ajh 6/24/2004 03:33' prior: 0!
+ An environment is a collection of temporary variable values that have escaped the original method context and placed in this environment because blocks existed in the method that reference these variables (and blocks may out live their creating context). Nested blocks create nested environments when temp vars are introduced at multiple levels and referenced at lower levels. So each environment has a parent environment in its first slot. The top environment has the original receiver in it first slot (if referenced by an inner block).
+ 
+ A block consists of its outer environment and a method to execute while the outer environment is in the receiver position.
+ 
+ A block that remote returns from its home context holds the home environment in its outer environment. The remote return unwinds the call stack to the context that created the home context.
+ !

Item was added:
+ ----- Method: ClosureEnvironment>>= (in category 'as yet unclassified') -----
+ = other
+ 
+ 	self class == other class ifFalse: [^ false].
+ 	self size = other size ifFalse: [^ false].
+ 	1 to: self size do: [:i |
+ 		(self at: i) = (other at: i) ifFalse: [^ false].
+ 	].
+ 	^ true!

Item was added:
+ ----- Method: ClosureEnvironment>>hash (in category 'as yet unclassified') -----
+ hash
+ 	"Answer an integer hash value for the receiver such that,
+ 	  -- the hash value of an unchanged object is constant over time, and
+ 	  -- two equal objects have equal hash values"
+ 
+ 	| hash |
+ 
+ 	hash _ self species hash.
+ 	self size <= 10 ifTrue:
+ 		[self do: [:elem | hash _ hash bitXor: elem hash]].
+ 	^hash bitXor: self size hash!

Item was added:
+ ----- Method: ClosureEnvironment>>return: (in category 'as yet unclassified') -----
+ return: value
+ 	"Find thisContext sender that is owner of self and return from it"
+ 
+ 	| home |
+ 	home _ thisContext findContextSuchThat: [:ctxt | ctxt myEnv == self].
+ 	home return: value!

Item was added:
+ RectangleMorph subclass: #CodecDemoMorph
+ 	instanceVariableNames: 'codecClassName'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sound-Interface'!

Item was added:
+ ----- Method: CodecDemoMorph>>acceptDroppingMorph:event: (in category 'layout') -----
+ acceptDroppingMorph: aMorph event: evt
+ 
+ 	| codecClass |
+ 	'None' = codecClassName
+ 		ifTrue: [aMorph sound play]
+ 		ifFalse: [
+ 			codecClass _ Smalltalk at: codecClassName ifAbsent: [^ self].
+ 			(codecClass new compressAndDecompress: aMorph sound) play].
+ 	aMorph position: self topRight + (10 at 0).
+ !

Item was added:
+ ----- Method: CodecDemoMorph>>addCustomMenuItems:hand: (in category 'menus') -----
+ addCustomMenuItems: aCustomMenu hand: aHandMorph
+ 
+ 	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ 	aCustomMenu add: 'select codec' translated action: #selectCodec.
+ !

Item was added:
+ ----- Method: CodecDemoMorph>>codecClassName: (in category 'as yet unclassified') -----
+ codecClassName: aStringOrSymbol
+ 
+ 	| label |
+ 	codecClassName _ aStringOrSymbol asSymbol.
+ 	self removeAllMorphs.
+ 	label _ StringMorph contents: aStringOrSymbol.
+ 	label position: self position + (5 at 5).
+ 	self addMorph: label.
+ 	label lock: true.
+ 	self extent: label extent + (10 at 10).
+ !

Item was added:
+ ----- Method: CodecDemoMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ "answer the default color/fill style for the receiver"
+ 	^ Color
+ 		r: 1.0
+ 		g: 0.806
+ 		b: 0.677!

Item was added:
+ ----- Method: CodecDemoMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	
+ 	self codecClassName: 'MuLawCodec'!

Item was added:
+ ----- Method: CodecDemoMorph>>selectCodec (in category 'as yet unclassified') -----
+ selectCodec
+ 
+ 	| aMenu codecs newCodec |
+ 	aMenu _ CustomMenu new title: 'Codec:'.
+ 	codecs _ (SoundCodec allSubclasses collect: [:c | c name]) asSortedCollection.
+ 	codecs add: 'None'.
+ 	codecs do:[:cName | aMenu add: cName action: cName].
+ 	newCodec _ aMenu startUp.
+ 	newCodec ifNil: [^ self].
+ 	self codecClassName: newCodec.
+ !

Item was added:
+ ----- Method: CodecDemoMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
+ wantsDroppedMorph: aMorph event: evt
+ 
+ 	^ aMorph isMemberOf: SoundTile
+ !

Item was added:
+ ----- Method: Collection>>explorerContents (in category '*Etoys-Squeakland-enumerating') -----
+ explorerContents
+ 
+ 	^self explorerContentsWithIndexCollect: [:value :index |
+ 		ObjectExplorerWrapper
+ 			with: value
+ 			name: index printString
+ 			model: self]!

Item was added:
+ ----- Method: Collection>>explorerContentsWithIndexCollect: (in category '*Etoys-Squeakland-enumerating') -----
+ explorerContentsWithIndexCollect: twoArgBlock
+ 
+ 	^ self asOrderedCollection withIndexCollect: twoArgBlock
+ !

Item was added:
+ ----- Method: Collection>>toBraceStack: (in category '*Etoys-Squeakland-private') -----
+ toBraceStack: itsSize 
+ 	"Push receiver's elements onto the stack of thisContext sender.  Error if receiver does
+ 	 not have itsSize elements or if receiver is unordered.
+ 	 Do not call directly: this is called by {a. b} _ ... constructs."
+ 
+ 	self size ~= itsSize ifTrue:
+ 		[self error: 'Trying to store ', self size printString,
+ 					' values into ', itsSize printString, ' variables.'].
+ 	thisContext sender push: itsSize fromIndexable: self!

Item was added:
+ ----- Method: Color class>>colorPaletteCaptionHeight (in category '*Etoys-Squeakland-color from user') -----
+ colorPaletteCaptionHeight
+ 	^ 20!

Item was added:
+ ----- Method: Color class>>colorPaletteForDepth:extent: (in category '*Etoys-Squeakland-color from user') -----
+ colorPaletteForDepth: depth extent: chartExtent
+ 	"Display a palette of colors sorted horizontally by hue and vertically by lightness. Useful for eyeballing the color gamut of the display, or for choosing a color interactively."
+ 	"Note: It is slow to build this palette, so it should be cached for quick access."
+ 	"(Color colorPaletteForDepth: 16 extent: 190 at 60) display"
+ 
+ 	| basicHue x y c startHue palette vSteps transCaption hSteps captionHeight |
+ 	palette _ Form extent: chartExtent depth: depth.
+ 	transCaption _ "(DisplayText text: 'no color' asText textStyle: (TextConstants at: #ComicPlain)) form storeString"
+ 		(Form extent: 34 at 9 depth: 1
+ 			fromArray: #(0 0 256 0 256 0 3808663859 2147483648 2491688266 2147483648 2491688266 0 2491688266 0 2466486578 0 0 0)
+ 			offset: 0 at 0).
+ 	captionHeight := self colorPaletteCaptionHeight.
+ 	palette fillWhite: (0 at 0 extent: palette width at captionHeight).
+ 	palette fillBlack: (0 at captionHeight extent: palette width at 1).
+ 	transCaption displayOn: palette at: palette boundingBox topCenter - ((transCaption width // 2)@0).
+ 	startHue _ 338.0.
+ 	vSteps _ palette height - captionHeight // 2.
+ 	hSteps _ palette width - self colorPaletteGrayWidth.
+ 	x _ 0.
+ 	startHue to: startHue + 360.0 by: 360.0/hSteps do: [:h |
+ 		basicHue _ Color h: h asFloat s: 1.0 v: 1.0.
+ 		y _ captionHeight+1.
+ 		0 to: vSteps do: [:n |
+  			c _ basicHue mixed: (n asFloat / vSteps asFloat) with: Color white.
+ 			palette fill: (x at y extent: 1 at 1) fillColor: c.
+ 			y _ y + 1].
+ 		1 to: vSteps do: [:n |
+  			c _ Color black mixed: (n asFloat / vSteps asFloat) with: basicHue.
+ 			palette fill: (x at y extent: 1 at 1) fillColor: c.
+ 			y _ y + 1].
+ 		x _ x + 1].
+ 	y _ captionHeight + 1.
+ 	1 to: vSteps * 2 do: [:n |
+  		c _ Color black mixed: (n asFloat / (vSteps*2) asFloat) with: Color white.
+ 		palette fill: (x at y extent: self colorPaletteGrayWidth @1) fillColor: c.
+ 		y _ y + 1].
+ 	^ palette
+ !

Item was added:
+ ----- Method: Color class>>colorPaletteGrayWidth (in category '*Etoys-Squeakland-color from user') -----
+ colorPaletteGrayWidth
+ 	^ 20!

Item was added:
+ ----- Method: Color class>>isPrototypeTurtlePlayer (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isPrototypeTurtlePlayer
+ 
+ 	^ false.
+ !

Item was added:
+ ----- Method: Color class>>noColorCaption (in category '*Etoys-Squeakland-color from user') -----
+ noColorCaption
+ 	| formTranslator |
+ 	formTranslator := NaturalLanguageFormTranslator localeID: Locale current localeID.
+ 	^ (formTranslator translate: 'no color')
+ 		ifNil: [Form
+ 				extent: 34 @ 9
+ 				depth: 1
+ 				fromArray: #(0 0 256 0 256 0 3808663859 2147483648 2491688266 2147483648 2491688266 0 2491688266 0 2466486578 0 0 0 )
+ 				offset: 0 @ 0]!

Item was added:
+ ----- Method: ColorPickerMorph class>>buttonSize (in category '*Etoys-Squeakland-class initialization') -----
+ buttonSize
+ 	^ 20 @ Color colorPaletteCaptionHeight!

Item was added:
+ ----- Method: ColorPickerMorph>>allowsTranslucency (in category '*Etoys-Squeakland-event handling') -----
+ allowsTranslucency
+ 	"Answer whether the receiver should respect attempts to choose transparency.  Shamefully nonmodular code here."
+ 
+ 	| isWorld |
+ 	(target isKindOf: GraphPaperPanel) ifTrue: [^ false].
+ 	isWorld := (target isPlayerLike and: [target costume isWorldMorph])
+ 		or:  [target isMorph and: [target isWorldMorph]] 
+ 		or: [(target isKindOf: UpdatingRectangleMorph) and: [target involvesWorldColor]].
+ 	^ isWorld not!

Item was added:
+ ----- Method: ColorPickerMorph>>deleteBoxHit (in category '*Etoys-Squeakland-event handling') -----
+ deleteBoxHit
+ 	"The delete box was hit..."
+ 
+ 	ActiveHand showTemporaryCursor: nil.
+ 	self delete!

Item was added:
+ ----- Method: ColorPickerMorph>>initializeForGraphPaperPanel (in category '*Etoys-Squeakland-initialization') -----
+ initializeForGraphPaperPanel
+ 	"Initialize the receiver for appearing as one of the color-pickers in a GraphPaperPanel."
+ 
+ 	isModal := false.
+ 	self removeAllMorphs.
+ 	self setProperty: #noDraggingThisPicker toValue: true.
+ 
+ 	self addMorph: ((Morph newBounds: (RevertBox translateBy: self topLeft))
+ 			color: Color transparent; setCenteredBalloonText: 'restore original color' translated).
+ 	self addMorph: ((Morph newBounds: (FeedbackBox translateBy: self topLeft))
+ 			color: Color transparent; setCenteredBalloonText: 'shows selected color' translated).
+ 
+ 	self buildChartForm.
+ 	
+ 	selectedColor ifNil: [selectedColor := Color white].
+ 	sourceHand := nil.
+ 	deleteOnMouseUp := false.
+ 	updateContinuously := true
+ !

Item was added:
+ ----- Method: ColorPickerMorph>>initializeForJustCursor (in category '*Etoys-Squeakland-initialization') -----
+ initializeForJustCursor
+ 
+ 	isModal _ true.
+ 	self removeAllMorphs.
+ 	selectedColor ifNil: [selectedColor _ Color white].
+ 	sourceHand _ nil.
+ 	deleteOnMouseUp _ false.
+ 	updateContinuously _ true.
+ 	noChart _ true.
+ 	self form: (Form extent: 2 at 2 depth: 16).
+ !

Item was added:
+ ----- Method: ColorPickerMorph>>noChart (in category '*Etoys-Squeakland-accessing') -----
+ noChart
+ 	"Answer the receiver's noChart, initializing it to false if found nil, as happens in ColorPickers lurking in pre-2006 projects."
+ 
+ 	^ noChart ifNil: [noChart := false]!

Item was added:
+ ----- Method: ColorPickerMorph>>noChart: (in category '*Etoys-Squeakland-accessing') -----
+ noChart: aBoolean
+ 	"Set the noChart variable as indicated."
+ 
+ 	noChart := aBoolean!

Item was added:
+ ----- Method: ColorPickerMorph>>openPropertySheet (in category '*Etoys-Squeakland-e-toy support') -----
+ openPropertySheet
+ 	"Delete the receiver and open a property sheet on my target instead."
+ 
+ 	ActiveHand showTemporaryCursor: nil.
+ 	target openAppropriatePropertySheet.
+ 	self delete
+ 
+ 	!

Item was added:
+ ----- Method: ColorPickerMorph>>slopeBox (in category '*Etoys-Squeakland-geometry') -----
+ slopeBox
+ 	^ TransparentBox insetBy: 20 at 0!

Item was changed:
  ----- Method: ColorSeerTile>>initialize (in category 'initialization') -----
  initialize
  "initialize the state of the receiver"
  	| m1 m2 desiredW wording |
  	super initialize.
  ""
  	self removeAllMorphs.
  	"get rid of the parts of a regular Color tile"
+ 	type _ #operator.
+ 	operatorOrExpression _ #color:sees:.
+ 	wording _ (Vocabulary eToyVocabulary
- 	type := #operator.
- 	operatorOrExpression := #color:sees:.
- 	wording := (Vocabulary eToyVocabulary
  				methodInterfaceAt: operatorOrExpression
  				ifAbsent: []) wording.
+ 	m1 _ StringMorph contents: wording font: ScriptingSystem fontForTiles.
+ 	m2 _ Morph new extent: 16 @ 14;
- 	m1 := StringMorph contents: wording font: ScriptingSystem fontForTiles.
- 	m2 := Morph new extent: 12 @ 8;
  				
  				color: (Color
  						r: 0.8
  						g: 0
  						b: 0).
+ 	desiredW _ m1 width + 6.
- 	desiredW := m1 width + 6.
  	self extent: (desiredW max: self basicWidth)
  			@ self class defaultH.
  	m1 position: bounds center x - (m1 width // 2) @ (bounds top + 5).
  	m2 position: bounds center x - (m2 width // 2) + 3 @ (bounds top + 8).
  	self addMorph: m1;
  		 addMorphFront: m2.
+ 	colorSwatch _ m2!
- 	colorSwatch := m2!

Item was added:
+ ----- Method: ColorSeerTile>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') -----
+ parseNodeWith: encoder
+ 	self error: 'should not reach here'.!

Item was added:
+ ----- Method: ColorSeerTile>>sexpWith: (in category '*Etoys-Squeakland-code generation') -----
+ sexpWith: dictionary 
+ 	self error: 'should not reach here'.!

Item was added:
+ ----- Method: ColorSystemView>>cacheBitsAsTwoTone (in category '*Etoys-Squeakland-as yet unclassified') -----
+ cacheBitsAsTwoTone
+ 	^ false!

Item was changed:
  ----- Method: ColorTileMorph>>addColorSwatch (in category 'other') -----
  addColorSwatch
  
  	| m1 m2 desiredW |
+ 	m1 _ StringMorph contents: 'color' translated font: ScriptingSystem fontForTiles.
+ 	m2 _ Morph new extent: 16 at 14; color: (Color r: 0.8 g: 0 b: 0).
+ 	desiredW _ m1 width + 6.
- 	m1 := StringMorph contents: 'color' translated font: ScriptingSystem fontForTiles.
- 	m2 := Morph new extent: 12 at 8; color: (Color r: 0.8 g: 0 b: 0).
- 	desiredW := m1 width + 6.
  	self extent: (desiredW max: self basicWidth) @ self class defaultH.
  	m1 position: (bounds center x - (m1 width // 2)) @ (bounds top + 1).
  	m2 position: (bounds center x - (m2 width // 2)) @ (m1 bottom - 1).
  	self addMorph: m1; addMorph: m2.
+ 	colorSwatch _ m2!
- 	colorSwatch := m2!

Item was changed:
  ----- Method: ColorTileMorph>>initialize (in category 'initialization') -----
  initialize
  "initialize the state of the receiver"
  	super initialize.
  ""
+ 	type _ #literal.
+ 	self addColorSwatch.
+ 	showPalette _ true.
+ !
- 	type := #literal.
- 	self addColorSwatch!

Item was changed:
  ----- Method: ColorTileMorph>>mouseUp: (in category 'event handling') -----
  mouseUp: evt
+ 	self changeColorTarget: self selector: #kedamaColorSwatchColor: originalColor: colorSwatch color hand: evt hand showPalette: self showPalette.
- 	self changeColorTarget: self selector: #kedamaColorSwatchColor: originalColor: colorSwatch color hand: evt hand
  !

Item was added:
+ ----- Method: ColorTileMorph>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') -----
+ parseNodeWith: encoder
+ 
+ 	^ encoder encodeLiteral: colorSwatch color.
+ 
+ !

Item was added:
+ ----- Method: ColorTileMorph>>sexpWith: (in category '*Etoys-Squeakland-code generation') -----
+ sexpWith: dictionary
+ 
+ 	^ SExpElement keyword: #literal attributes: (SExpAttributes with: #value->colorSwatch color printString with: #type->'Color').
+ !

Item was added:
+ ----- Method: ColorTileMorph>>showPalette (in category '*Etoys-Squeakland-accessing') -----
+ showPalette
+ 
+ 	^ showPalette isNil or: [showPalette].
+ 
+ !

Item was added:
+ ----- Method: ColorTileMorph>>showPalette: (in category '*Etoys-Squeakland-accessing') -----
+ showPalette: aBoolean
+ 
+ 	showPalette _ aBoolean.
+ !

Item was changed:
  ----- Method: ColorType>>updatingTileForTarget:partName:getter:setter: (in category '*Etoys-tiles') -----
  updatingTileForTarget: aTarget partName: partName getter: getter setter: setter
  	"Answer, for classic tiles, an updating readout tile for a part with the receiver's type, with the given getter and setter"
  
  	| readout |
+ 	readout _ UpdatingRectangleMorph new.
- 	readout := UpdatingRectangleMorph new.
  	readout
  		getSelector: getter;
  		target: aTarget;
  		borderWidth: 1;
+ 		extent:  20 at 20.
- 		extent:  22 at 22.
  	((aTarget isKindOf: KedamaExamplerPlayer) and: [getter = #getColor]) ifTrue: [
  		readout getSelector: #getColorOpaque.
  	].
  	(setter isNil or: [#(unused none #nil) includes: setter]) ifFalse:
  		[readout putSelector: setter].
  	^ readout
  !

Item was added:
+ TileLikeMorph subclass: #CommandTilesMorph
+ 	instanceVariableNames: 'morph playerScripted'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Scripting Tiles'!
+ 
+ !CommandTilesMorph commentStamp: '<historical>' prior: 0!
+ An entire Smalltalk statement in tiles.  A line of code.!

Item was added:
+ ----- Method: CommandTilesMorph>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	super initialize.
+ 	self wrapCentering: #center; cellPositioning: #leftCenter.
+ 	self hResizing: #shrinkWrap.
+ 	borderWidth _ 0.
+ 	self layoutInset: 0.
+ 	self extent: 5 at 5.  "will grow to fit"
+ !

Item was added:
+ ----- Method: CommandTilesMorph>>setMorph: (in category 'initialization') -----
+ setMorph: aMorph
+ 	playerScripted _ aMorph playerScripted
+ !

Item was added:
+ ----- Method: CommandTilesMorph>>tileRows (in category 'miscellaneous') -----
+ tileRows
+ 
+ 	^ Array with: self submorphs!

Item was added:
+ ----- Method: CommentNode>>defaultBlockType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultBlockType: t1 
+ 	^ #default!

Item was added:
+ ----- Method: CommentNode>>defaultMessageType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultMessageType
+ 	^ #none!

Item was added:
+ ----- Method: CommentNode>>firstInReceivers: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ firstInReceivers: t1 
+ 	^ t1 first!

Item was added:
+ ----- Method: CommentNode>>getAllChildren (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getAllChildren
+ 
+ 	^ nil.
+ !

Item was added:
+ ----- Method: CommentNode>>getElderSiblingOf: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getElderSiblingOf: node
+ 
+ 	^ nil.
+ !

Item was added:
+ ----- Method: CommentNode>>isLeaf (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isLeaf
+ 
+ 	^ true.
+ !

Item was added:
+ ----- Method: CommentNode>>isStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isStmt: t1 
+ 	^ t1 = #top
+ 		or: [t1 = #condition]!

Item was added:
+ ----- Method: CommentNode>>isTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTest: t1 parentNode: t2 
+ 	t1 = true
+ 		ifTrue: [^ true].
+ 	^ (t2 isMemberOf: MessageNode)
+ 		and: [t2 receiver = self
+ 				and: [t2 messageType value = #condition]]!

Item was added:
+ ----- Method: CommentNode>>isTopStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmt: t1 
+ 	t1 = nil
+ 		ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: CommentNode>>rcvr: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr: t1 
+ 	^ t1!

Item was added:
+ ----- Method: CommentNode>>thisNode (in category '*Etoys-Tweak-Kedama-Generated') -----
+ thisNode
+ 	^ self!

Item was added:
+ ----- Method: CommentNode>>transfer: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 
+ 	^ t1!

Item was added:
+ ----- Method: CommentNode>>visitBy: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ visitBy: visitor
+ 
+ 	visitor visit: self.
+ !

Item was added:
+ ----- Method: CompiledMethod>>cacheTempNames: (in category '*Etoys-Squeakland-source code management') -----
+ cacheTempNames: names
+ 
+ 	TempNameCache _ Association key: self value: names!

Item was added:
+ ----- Method: CompiledMethod>>decompileClass:selector: (in category '*Etoys-Squeakland-decompiling') -----
+ decompileClass: aClass selector: selector
+ 	"Return the decompiled parse tree that represents self"
+ 	^ self decompilerClass new decompile: selector in: aClass method: self methodForDecompile!

Item was added:
+ ----- Method: CompiledMethod>>methodNodeDecompileClass:selector: (in category '*Etoys-Squeakland-decompiling') -----
+ methodNodeDecompileClass: aClass selector: selector
+ 	"Return the parse tree that represents self"
+ 
+ 	| source |
+ 	^ ((source _ self getSourceFromFile) isNil or: [
+ 		(MMetaCompiler metaProductionName: source asString) notNil]) ifTrue: [
+ 			self decompileClass: aClass selector: selector
+ 		] ifFalse: [self parserClass new parse: source class: (aClass ifNil: [self sourceClass])]
+ !

Item was added:
+ ----- Method: CompiledMethod>>qDecompress: (in category '*Etoys-Squeakland-source code management') -----
+ qDecompress: byteArray
+ 	"Decompress strings compressed by qCompress:.
+ 	Most common 12 chars get values 0-11 packed in one 4-bit nibble;
+ 	others get values 12-15 (2 bits) * 16 plus next nibble"
+ 	|  charTable extended ext |
+ 	charTable _  "Character encoding table must match qCompress:"
+ 	' eatrnoislcm bdfghjkpquvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'.
+ 	^ String streamContents:
+ 		[:strm | extended _ false.  "Flag for 2-nibble characters"
+ 		byteArray do:
+ 			[:byte | 
+ 			(Array with: byte//16 with: byte\\16)
+ 				do:
+ 				[:nibble | extended
+ 					ifTrue: [strm nextPut: (charTable at: ext*16+nibble + 1). extended _ false]
+ 					ifFalse: [nibble < 12 ifTrue: [strm nextPut: (charTable at: nibble + 1)]
+ 									ifFalse: [ext _ nibble-12.  extended _ true]]]]]!

Item was added:
+ ----- Method: CompiledMethod>>scanLongLoad: (in category '*Etoys-Squeakland-scanning') -----
+ scanLongLoad: extension 
+ 	"Answer whether the receiver contains a long load whose extension is the 
+ 	argument."
+ 
+ 	| scanner |
+ 	scanner _ InstructionStream on: self.
+ 	^scanner scanFor: [:instr | instr = 128 and: [scanner followingByte = extension]]!

Item was added:
+ ----- Method: CompiledMethod>>scanLongStore: (in category '*Etoys-Squeakland-scanning') -----
+ scanLongStore: extension 
+ 	"Answer whether the receiver contains a long store whose extension is 
+ 	the argument."
+ 	| scanner |
+ 	scanner _ InstructionStream on: self.
+ 	^scanner scanFor: 
+ 		[:instr |  (instr = 129 or: [instr = 130]) and: [scanner followingByte = extension]]!

Item was added:
+ ----- Method: CompiledMethod>>scanVeryLongLoad:offset: (in category '*Etoys-Squeakland-scanning') -----
+ scanVeryLongLoad: extension offset: offset
+ 	"Answer whether the receiver contains a long load whose extension is the 
+ 	argument."
+ 	| scanner |
+ 	scanner _ InstructionStream on: self.
+ 	^ scanner scanFor: [:instr | (instr = 132 and: [scanner followingByte = extension])
+ 											and: [scanner thirdByte = offset]]!

Item was added:
+ ----- Method: CompiledMethod>>setTempNamesIfCached: (in category '*Etoys-Squeakland-source code management') -----
+ setTempNamesIfCached: aBlock
+ 	"This is a cache used by the debugger, independent of the storage of
+ 	temp names when the system is converted to decompilation with temps."
+ 	TempNameCache == nil ifTrue: [^self].
+ 	TempNameCache key == self
+ 		ifTrue: [aBlock value: TempNameCache value]!

Item was added:
+ ----- Method: CompiledMethod>>who (in category '*Etoys-Squeakland-printing') -----
+ who
+ 	"Answer an Array of the class in which the receiver is defined and the 
+ 	selector to which it corresponds."
+ 
+ 	self hasNewPropertyFormat ifTrue:[^{self methodClass. self selector}].
+ 	self systemNavigation allBehaviorsDo: 
+ 		[:class | 
+ 		(class methodDict keyAtIdentityValue: self ifAbsent: [nil]) ifNotNilDo:
+ 			[:sel| ^Array with: class with: sel]].
+ 	^Array with: #unknown with: #unknown!

Item was added:
+ Player subclass: #Component
+ 	instanceVariableNames: 'model pinSpecs'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Components'!

Item was added:
+ ----- Method: Component class>>acceptsLoggingOfCompilation (in category 'compiling') -----
+ acceptsLoggingOfCompilation
+ 	"Log everything for now"
+ 
+ 	^ true!

Item was added:
+ ----- Method: Component class>>addSlotNamed: (in category 'as yet unclassified') -----
+ addSlotNamed: aName
+ 	(self allInstVarNames includes: aName) ifTrue: [self error: 'Duplicate slot name'].
+ 	self addInstVarName: aName.
+ !

Item was added:
+ ----- Method: Component class>>includeInNewMorphMenu (in category 'as yet unclassified') -----
+ includeInNewMorphMenu
+ 	"Only include instances of subclasses of me"
+ 	^ self ~~ Component!

Item was added:
+ ----- Method: Component class>>wantsChangeSetLogging (in category 'compiling') -----
+ wantsChangeSetLogging
+ 	"Log changes for Component itself, but not for automatically-created subclasses like Component1, Component2"
+ 
+ 	"^ self == Component or:
+ 		[(self class name beginsWith: 'Component') not]"
+ 
+ 	"Log everything for now"
+ 	false ifTrue: [self halt  "DONT FORGET TO REORDER FILEOUT"].
+ 	^ true!

Item was added:
+ ----- Method: Component>>addVariableNamed: (in category 'variables') -----
+ addVariableNamed: varName 
+ 	"Adjust name if necessary and add it"
+ 
+ 	| otherNames i partName |
+ 	otherNames := self class allInstVarNames.
+ 	i := nil.
+ 	
+ 	[partName := i isNil 
+ 		ifTrue: [varName]
+ 		ifFalse: [varName , i printString].
+ 	otherNames includes: partName] 
+ 			whileTrue: [i := i isNil ifTrue: [1] ifFalse: [i + 1]].
+ 	self class addInstVarName: partName.
+ 
+ 	"Now compile read method and write-with-change method"
+ 	self class 
+ 		compile: (String streamContents: 
+ 					[:s | 
+ 					s
+ 						nextPutAll: partName;
+ 						cr;
+ 						tab;
+ 						nextPutAll: '^' , partName])
+ 		classified: 'view access'
+ 		notifying: nil.
+ 	self class 
+ 		compile: (String streamContents: 
+ 					[:s | 
+ 					s
+ 						nextPutAll: partName , 'Set: newValue';
+ 						cr;
+ 						tab;
+ 						nextPutAll: partName , ' _ newValue.';
+ 						cr;
+ 						tab;
+ 						nextPutAll: 'self changed: #' , partName , '.';
+ 						cr;
+ 						tab;
+ 						nextPutAll: '^ true'	"for components that expect a boolean for accept"])
+ 		classified: 'view access'
+ 		notifying: nil.
+ 	^Array with: partName asSymbol with: (partName , 'Set:') asSymbol!

Item was added:
+ ----- Method: Component>>chooseNameLike: (in category 'naming') -----
+ chooseNameLike: someName 
+ 	| stem otherNames i partName |
+ 	stem _ someName.
+ 	(stem size > 5 and: [stem endsWith: 'Morph'])
+ 		ifTrue: [stem _ stem copyFrom: 1 to: stem size - 5].
+ 	stem _ stem first asLowercase asString , stem allButFirst.
+ 	otherNames _ self class allInstVarNames asSet.
+ 	"otherNames addAll: self world allKnownNames."
+ 	i _ 1.
+ 	[otherNames includes: (partName _ stem , i printString)]
+ 		whileTrue: [i _ i + 1].
+ 	partName _ FillInTheBlank request: 'Please give this part a name'
+ 						initialAnswer: partName.
+ 	partName isEmpty ifTrue: [^ nil].
+ 	(otherNames includes: partName) ifTrue:
+ 			[self inform: 'Sorry, that name is already used'.
+ 			^ nil].
+ 	^ partName!

Item was added:
+ ----- Method: Component>>externalName (in category 'viewer') -----
+ externalName 
+ 	^ self class name!

Item was added:
+ ----- Method: Component>>initComponentIn: (in category 'initialize') -----
+ initComponentIn: aLayout
+ 	model _ aLayout model.
+ 	self nameMeIn: aLayout world.
+ 	self color: Color lightCyan.
+ 	self showPins.
+ 	model addDependent: self!

Item was added:
+ ----- Method: Component>>justDroppedInto:event: (in category 'drag and drop') -----
+ justDroppedInto: aMorph event: anEvent
+ 	| theModel |
+ 	theModel _ aMorph model.
+ 	((aMorph isKindOf: ComponentLayout) 
+ 		and: [theModel isKindOf: Component]) ifFalse:
+ 		["Disconnect prior to removal by move"
+ 		(theModel isKindOf: Component) ifTrue: [self unwire.  model _ nil].
+ 		^ super justDroppedInto: aMorph event: anEvent].
+ 	theModel == model ifTrue: [^ self  "Presumably just a move"].
+ 	self initComponentIn: aMorph.
+ 	super justDroppedInto: aMorph event: anEvent.!

Item was added:
+ ----- Method: Component>>nameMeIn: (in category 'naming') -----
+ nameMeIn: aWorld
+ 	| stem otherNames i partName className |
+ 	className _ self class name.
+ 	stem _ className.
+ 	(stem size > 5 and: [stem endsWith: 'Morph'])
+ 		ifTrue: [stem _ stem copyFrom: 1 to: stem size - 5].
+ 	stem _ stem first asLowercase asString , stem allButFirst.
+ 	otherNames _ Set newFrom: aWorld allKnownNames.
+ 	i _ 1.
+ 	[otherNames includes: (partName _ stem , i printString)]
+ 		whileTrue: [i _ i + 1].
+ 	self setNamePropertyTo: partName!

Item was added:
+ ----- Method: Component>>removeVariableNamed: (in category 'variables') -----
+ removeVariableNamed: varName 
+ 	self class removeSelector: varName.
+ 	self class removeSelector: (varName , 'Set:') asSymbol.
+ 	self class removeInstVarName: varName asString!

Item was added:
+ ----- Method: Component>>renameMe (in category 'naming') -----
+ renameMe
+ 	| newName |
+ 	newName _ self chooseNameLike: self knownName.
+ 	newName ifNil: [^ nil].
+ 	self setNamePropertyTo: newName!

Item was added:
+ PasteUpMorph subclass: #ComponentLayout
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Components'!

Item was added:
+ ----- Method: ComponentLayout>>acceptDroppingMorph:event: (in category 'layout') -----
+ acceptDroppingMorph: aMorph event: evt
+ 	"Eschew all of PasteUp's mechanism for now"
+ 
+ 	self addMorph: aMorph.
+ !

Item was added:
+ ----- Method: ComponentLayout>>addCustomMenuItems:hand: (in category 'menus') -----
+ addCustomMenuItems: menu hand: aHandMorph
+ 
+ 	super addCustomMenuItems: menu hand: aHandMorph.
+ 	menu addLine.
+ 	menu add: 'inspect model in morphic' translated action: #inspectModelInMorphic!

Item was added:
+ ----- Method: ComponentLayout>>allKnownNames (in category 'submorphs-accessing') -----
+ allKnownNames
+ 	^super allKnownNames 
+ 		, (self submorphs collect: [:m | m knownName] thenSelect: [:m | m notNil])!

Item was added:
+ ----- Method: ComponentLayout>>createCustomModel (in category 'model') -----
+ createCustomModel
+ 	"Create a model object for this world if it does not yet have one.
+ 	The default model for an EditView is a Component."
+ 
+ 	model isNil ifFalse: [^self].	"already has a model"
+ 	model := Component newSubclass new!

Item was added:
+ ----- Method: ComponentLayout>>initialize (in category 'initialization') -----
+ initialize
+ 	super initialize.
+ 	self createCustomModel.
+ 	self extent: 384 at 256!

Item was added:
+ ----- Method: ComponentLayout>>inspectModelInMorphic (in category 'as yet unclassified') -----
+ inspectModelInMorphic
+ 	| insp |
+ 	insp _ InspectorBrowser openAsMorphOn: self model.
+ 	self world addMorph: insp; startStepping: insp!

Item was added:
+ MorphicModel subclass: #ComponentLikeModel
+ 	instanceVariableNames: 'pinSpecs'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Components'!

Item was added:
+ ----- Method: ComponentLikeModel>>addPinFromSpec: (in category 'components') -----
+ addPinFromSpec: pinSpec
+ 	| pin |
+ 	pin _ PinMorph new component: self pinSpec: pinSpec.
+ 	self addMorph: pin.
+ 	pin placeFromSpec.
+ 	^ pin!

Item was added:
+ ----- Method: ComponentLikeModel>>choosePartName (in category 'naming') -----
+ choosePartName
+ 	"When I am renamed, get a slot, make default methods, move any existing methods."
+ 
+ 	| old |
+ 	(self pasteUpMorph model isKindOf: Component) 
+ 		ifTrue: 
+ 			[self knownName ifNil: [^self nameMeIn: self pasteUpMorph]
+ 				ifNotNil: [^self renameMe]].
+ 	old := slotName.
+ 	super choosePartName.
+ 	slotName ifNil: [^self].	"user chose bad slot name"
+ 	self model: self world model slotName: slotName.
+ 	old isNil 
+ 		ifTrue: [self compilePropagationMethods]
+ 		ifFalse: [self copySlotMethodsFrom: old]
+ 	"old ones not erased!!"!

Item was added:
+ ----- Method: ComponentLikeModel>>delete (in category 'submorphs-add/remove') -----
+ delete
+ 	"Delete the receiver.  Possibly put up confirming dialog.  Abort if user changes mind"
+ 
+ 	(model isKindOf: Component) ifTrue: [^self deleteComponent].
+ 	(model isMorphicModel) ifFalse: [^super delete].
+ 	slotName ifNotNil: 
+ 			[(PopUpMenu confirm: 'Shall I remove the slot ' , slotName 
+ 						, '
+ 	along with all associated methods?') 
+ 				ifTrue: 
+ 					[(model class selectors select: [:s | s beginsWith: slotName]) 
+ 						do: [:s | model class removeSelector: s].
+ 					(model class instVarNames includes: slotName) 
+ 						ifTrue: [model class removeInstVarName: slotName]]
+ 				ifFalse: 
+ 					[(PopUpMenu 
+ 						confirm: '...but should I at least dismiss this morph?
+ 	[choose no to leave everything unchanged]') 
+ 							ifFalse: [^self]]].
+ 	super delete!

Item was added:
+ ----- Method: ComponentLikeModel>>deleteComponent (in category 'components') -----
+ deleteComponent
+ 	model removeDependent: self.
+ 	self pinsDo: [:pin | pin delete].
+ 	^ super delete!

Item was added:
+ ----- Method: ComponentLikeModel>>duplicate:from: (in category 'initialization') -----
+ duplicate: newGuy from: oldGuy
+ 	"oldGuy has just been duplicated and will stay in this world.  Make sure all the ComponentLikeModel requirements are carried out for the copy.  Ask user to rename it.  "
+ 
+ 	newGuy installModelIn: oldGuy pasteUpMorph.
+ 	newGuy copySlotMethodsFrom: oldGuy slotName.!

Item was added:
+ ----- Method: ComponentLikeModel>>extent: (in category 'geometry') -----
+ extent: newExtent
+ 	super extent: newExtent.
+ 	self submorphsDo: [:m | (m isKindOf: PinMorph) ifTrue: [m placeFromSpec]]!

Item was added:
+ ----- Method: ComponentLikeModel>>initComponentIn: (in category 'components') -----
+ initComponentIn: aLayout
+ 	model _ aLayout model.
+ 	self nameMeIn: aLayout.
+ 	self color: Color lightCyan.
+ 	self initPinSpecs.
+ 	self initFromPinSpecs.
+ 	self showPins.
+ 	model addDependent: self!

Item was added:
+ ----- Method: ComponentLikeModel>>initFromPinSpecs (in category 'components') -----
+ initFromPinSpecs
+ 	"no-op for default"!

Item was added:
+ ----- Method: ComponentLikeModel>>initPinSpecs (in category 'components') -----
+ initPinSpecs
+ 	"no-op for default"
+ 	pinSpecs _ Array new.
+ !

Item was added:
+ ----- Method: ComponentLikeModel>>justDroppedInto:event: (in category 'dropping/grabbing') -----
+ justDroppedInto: aMorph event: anEvent
+ 	| theModel |
+ 	theModel _ aMorph modelOrNil.
+ 	((aMorph isKindOf: ComponentLayout) 
+ 		and: [theModel isKindOf: Component]) ifFalse:
+ 		["Disconnect prior to removal by move"
+ 		(theModel isKindOf: Component) ifTrue: [self unwire.  model _ nil].
+ 		^ super justDroppedInto: aMorph event: anEvent].
+ 	theModel == model ifTrue: [^ self  "Presumably just a move"].
+ 	self initComponentIn: aMorph.
+ 	super justDroppedInto: aMorph event: anEvent!

Item was added:
+ ----- Method: ComponentLikeModel>>nameMeIn: (in category 'components') -----
+ nameMeIn: aWorld
+ 	| stem otherNames i partName className |
+ 	className _ self class name.
+ 	stem _ className.
+ 	(stem size > 5 and: [stem endsWith: 'Morph'])
+ 		ifTrue: [stem _ stem copyFrom: 1 to: stem size - 5].
+ 	stem _ stem first asLowercase asString , stem allButFirst.
+ 	otherNames _ Set newFrom: aWorld allKnownNames.
+ 	i _ 1.
+ 	[otherNames includes: (partName _ stem , i printString)]
+ 		whileTrue: [i _ i + 1].
+ 	self setNamePropertyTo: partName!

Item was added:
+ ----- Method: ComponentLikeModel>>pinSpecs (in category 'components') -----
+ pinSpecs
+ 	^ pinSpecs!

Item was added:
+ ----- Method: ComponentLikeModel>>pinsDo: (in category 'components') -----
+ pinsDo: pinBlock
+ 	self submorphsDo: [:m | (m isKindOf: PinMorph) ifTrue: [pinBlock value: m]]!

Item was added:
+ ----- Method: ComponentLikeModel>>renameMe (in category 'components') -----
+ renameMe
+ 	| otherNames newName |
+ 	otherNames _ Set newFrom: self pasteUpMorph allKnownNames.
+ 	newName _ FillInTheBlank request: 'Please give this new a name'
+ 						initialAnswer: self knownName.
+ 	newName isEmpty ifTrue: [^ nil].
+ 	(otherNames includes: newName) ifTrue:
+ 			[self inform: 'Sorry, that name is already used'. ^ nil].
+ 	self setNamePropertyTo: newName!

Item was added:
+ ----- Method: ComponentLikeModel>>showPins (in category 'components') -----
+ showPins
+ 	"Make up sensitized pinMorphs for each of my interface variables"
+ 	self pinSpecs do: [:pinSpec | self addPinFromSpec: pinSpec]!

Item was changed:
  TileLikeMorph subclass: #CompoundTileMorph
+ 	instanceVariableNames: 'type testPart yesPart noPart justGrabbedFromViewer'
- 	instanceVariableNames: 'type testPart yesPart noPart'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Etoys-Scripting Tiles'!
  
  !CompoundTileMorph commentStamp: '<historical>' prior: 0!
  A statement with other whole statements inside it.  If-Then.  Test.!

Item was added:
+ ----- Method: CompoundTileMorph>>aboutToBeAcceptedInScriptor (in category '*Etoys-Squeakland-miscellaneous') -----
+ aboutToBeAcceptedInScriptor
+ 	"The receiver is about to be accepted in a Scriptor.  Adjust state information accordingly."
+ 
+ 	justGrabbedFromViewer _ false.
+ 	self removeProperty: #newPermanentScript.
+ 	self removeProperty: #newPermanentPlayer.
+ !

Item was added:
+ ----- Method: CompoundTileMorph>>addCommandFeedback: (in category '*Etoys-Squeakland-miscellaneous') -----
+ addCommandFeedback: evt
+ 	"Add screen feedback showing what would be torn off in a drag"
+ 
+ 	| aMorph |
+ 	
+ 	aMorph _ RectangleMorph new bounds: (self bounds).
+ 	aMorph beTransparent; borderWidth: 2; borderColor: ScriptingSystem commandFeedback; lock.
+ 	ActiveWorld addHighlightMorph: aMorph for: self outmostScriptEditor!

Item was added:
+ ----- Method: CompoundTileMorph>>blockNode:with: (in category '*Etoys-Squeakland-code generation') -----
+ blockNode: scriptPart with: encoder
+ 
+ 	^ BlockNode new arguments: #() statements: (self blockNodeElements: scriptPart with: encoder) returns: false from: encoder.
+ !

Item was added:
+ ----- Method: CompoundTileMorph>>blockNodeElements:with: (in category '*Etoys-Squeakland-code generation') -----
+ blockNodeElements: scriptPart with: encoder
+ 
+ 	| rows r |
+ 	rows _ scriptPart tileRows.
+ 	^ Array streamContents: [:strm |
+ 		1 to: rows size do: [:i |
+ 		r _ rows at: i.
+ 			r do: [:t | strm nextPut: (t parseNodeWith: encoder asStatement: true)].
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: CompoundTileMorph>>delegatingMouseEnter: (in category '*Etoys-Squeakland-initialization') -----
+ delegatingMouseEnter: evt
+ 
+ 	| o oo |
+ 	(o _ self owner) ifNotNil: [(oo _ o owner) ifNotNil: [^ oo mouseEnter: evt]].
+ !

Item was added:
+ ----- Method: CompoundTileMorph>>evaluateOn: (in category '*Etoys-Squeakland-etoys-debugger') -----
+ evaluateOn: anEtoysDebugger
+ 	^ anEtoysDebugger evaluateTest: self!

Item was added:
+ ----- Method: CompoundTileMorph>>evaluateTestPart (in category '*Etoys-Squeakland-etoys-debugger') -----
+ evaluateTestPart
+ 	| condition |
+ 	condition := testPart tiles at: 1 ifAbsent: [^ true].
+ 	^ Compiler evaluate: condition codeString
+ 				for: (condition associatedPlayer
+ 					ifNil: [condition topEditor playerScripted])
+ 				logged: false!

Item was changed:
  ----- Method: CompoundTileMorph>>initialize (in category 'initialization') -----
  initialize
  	"initialize the state of the receiver"
  
+ 	| r stringMorph d h |
- 	| r stringMorph |
  	super initialize.
  	self layoutInset: 2.
  	self listDirection: #topToBottom.
  	self hResizing: #shrinkWrap; vResizing: #shrinkWrap; cellInset: (0 @ 1); minCellSize: (200 at 14).
+ 	h := Preferences standardEToysFont height.
  	"NB: hResizing gets reset to #spaceFill below, after the standalone structure is created"
+ 	r _ AlignmentMorph newRow color: color;
- 	r := AlignmentMorph newRow color: color;
  				 layoutInset: 0.
  	r setProperty: #demandsBoolean toValue: true.
  	r addMorphBack: (Morph new color: color;
  			 extent: 2 @ 5).
  	"spacer"
+ 	stringMorph _ StringMorph new contents: 'Test' translated.
- 	stringMorph := StringMorph new contents: 'Test' translated.
  	stringMorph name: 'Test'.
+ 	stringMorph font: Preferences standardEToysFont.
+ 	stringMorph on: #mouseEnterDragging send: #delegatingMouseEnter: to: self.
  	r addMorphBack: stringMorph.
  	r addMorphBack: (Morph new color: color;
  			 extent: 5 @ 5).
  	"spacer"
+ 	r addMorphBack: (testPart _ BooleanScriptEditor new borderWidth: 0;
- 	r addMorphBack: (testPart := BooleanScriptEditor new borderWidth: 0;
  					 layoutInset: 1).
  	testPart color: Color transparent.
+ 	testPart height: h; minHeight: h.
  	testPart hResizing: #spaceFill.
  	self addMorphBack: r.
+ 	r _ AlignmentMorph newRow color: color;
- 	r := AlignmentMorph newRow color: color;
  				 layoutInset: 0.
+ 	r addMorphBack: (d _ Morph new color: color;
+ 			 extent: 30 @ stringMorph height)."stringMorph is refering to wrong one, but ok."
+ 	d on: #mouseEnterDragging send: #delegatingMouseEnter: to: self.
- 	r addMorphBack: (Morph new color: color;
- 			 extent: 30 @ 5).
  	"spacer"
+ 	stringMorph _ StringMorph new contents: 'Yes' translated.
- 	stringMorph := StringMorph new contents: 'Yes' translated.
  	stringMorph name: 'Yes'.
+ 	stringMorph font: Preferences standardEToysFont.
  	r addMorphBack: stringMorph.
  	r addMorphBack: (Morph new color: color;
  			 extent: 5 @ 5).
  	"spacer"
+ 	r addMorphBack: (yesPart _ ScriptEditorMorph new borderWidth: 0;
- 	r addMorphBack: (yesPart := ScriptEditorMorph new borderWidth: 0;
  					 layoutInset: 2).
+ 	yesPart height: h; minHeight: h.
  	yesPart hResizing: #spaceFill.
  	yesPart color: Color transparent.
  	self addMorphBack: r.
+ 	r _ AlignmentMorph newRow color: color;
- 	r := AlignmentMorph newRow color: color;
  				 layoutInset: 0.
+ 	r addMorphBack: (d _ Morph new color: color;
+ 			 extent: 35 @ stringMorph height).
+ 	d on: #mouseEnterDragging send: #delegatingMouseEnter: to: self.
- 	r addMorphBack: (Morph new color: color;
- 			 extent: 35 @ 5).
  	"spacer"
+ 	stringMorph _ StringMorph new contents: 'No' translated.
- 	stringMorph := StringMorph new contents: 'No' translated.
  	stringMorph name: 'No'.
+ 	stringMorph font: Preferences standardEToysFont.
  	r addMorphBack: stringMorph.
  	r addMorphBack: (Morph new color: color;
  			 extent: 5 @ 5).
  	"spacer"
+ 	r addMorphBack: (noPart _ ScriptEditorMorph new borderWidth: 0;
- 	r addMorphBack: (noPart := ScriptEditorMorph new borderWidth: 0;
  					 layoutInset: 2).
+ 	noPart height: h; minHeight: h.
  	noPart hResizing: #spaceFill.
  	noPart color: Color transparent.
  	self addMorphBack: r.
  	self bounds: self fullBounds.
  	self updateWordingToMatchVocabulary.
   	self hResizing:#spaceFill
  !

Item was added:
+ ----- Method: CompoundTileMorph>>justGrabbedFromViewer (in category '*Etoys-Squeakland-miscellaneous') -----
+ justGrabbedFromViewer
+ 	"Answer whether the receiver originated in a Viewer.  Only tiles that originated in a viewer will ever do that infernal sprouting of a new script around them.  The nil branch is only for backward compatibility."
+ 
+ 	^ justGrabbedFromViewer ifNil: [justGrabbedFromViewer _ true]!

Item was added:
+ ----- Method: CompoundTileMorph>>justGrabbedFromViewer: (in category '*Etoys-Squeakland-miscellaneous') -----
+ justGrabbedFromViewer: aBoolean
+ 	"Set the receiver's justGrabbedFromViewer instance variable"
+ 
+ 	justGrabbedFromViewer _ aBoolean!

Item was added:
+ ----- Method: CompoundTileMorph>>justGrabbedFromViewerOrNil (in category '*Etoys-Squeakland-miscellaneous') -----
+ justGrabbedFromViewerOrNil
+ 	"Answer the value of the receiver's justGrabbedFromViewer slot.  Needed only for conversion methods"
+ 
+ 	^ justGrabbedFromViewer!

Item was added:
+ ----- Method: CompoundTileMorph>>labelMorphs (in category '*Etoys-Squeakland-access') -----
+ labelMorphs
+ 
+ 	| w |
+ 	w := WriteStream on: (Array new: 3).
+ 	w nextPut: self submorphs first submorphs second.
+ 	w nextPut: self submorphs second submorphs second.
+ 	w nextPut: self submorphs third submorphs second.
+ 	^ w contents.
+ !

Item was changed:
  ----- Method: CompoundTileMorph>>mouseEnter: (in category 'event handling') -----
  mouseEnter: evt
  	"Resume drop-tracking in enclosing editor"
+ 	self removeHighlightFeedback.
+ 	self addCommandFeedback: evt.
+ !
- 	| ed |
- 	(ed := self enclosingEditor) ifNotNil:
- 		[ed mouseLeave: evt]!

Item was changed:
  ----- Method: CompoundTileMorph>>mouseEnterDragging: (in category 'event handling') -----
  mouseEnterDragging: evt
+ 	^ self.
+ !
- 	"Test button state elsewhere if at all"
- 	^ self mouseEnter: evt!

Item was changed:
  ----- Method: CompoundTileMorph>>mouseLeave: (in category 'event handling') -----
  mouseLeave: evt
  	"Resume drop-tracking in enclosing editor"
  	| ed |
+ 	self removeHighlightFeedback.
+ 	(ed _ self enclosingEditor) ifNotNil: [^ed mouseEnterDragging: evt].!
- 	(ed := self enclosingEditor) ifNotNil:
- 		[ed mouseEnter: evt]!

Item was changed:
  ----- Method: CompoundTileMorph>>mouseLeaveDragging: (in category 'event handling') -----
  mouseLeaveDragging: evt
  	"Test button state elsewhere if at all"
+ 	
+ 	self removeHighlightFeedback.
+ 	self mouseLeave: evt
+ 	
+ 	
+ !
- 	^ self mouseLeave: evt!

Item was added:
+ ----- Method: CompoundTileMorph>>noPart (in category '*Etoys-Squeakland-etoys-debugger') -----
+ noPart
+ 	^ noPart!

Item was added:
+ ----- Method: CompoundTileMorph>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') -----
+ parseNodeWith: encoder
+ 
+ 	| rec yes no |
+ 	rec _ (self blockNodeElements: testPart with: encoder).
+ 	rec size > 0 ifTrue: [rec _ rec last] ifFalse: [rec _ encoder encodeLiteral: true].
+ 	yes _ self blockNode: yesPart with: encoder.
+ 	no _ self blockNode: noPart with: encoder.
+ 
+ 	^ MessageNode new
+ 				receiver: rec
+ 				selector: #ifTrue:ifFalse:
+ 				arguments: (Array with: yes with: no)
+ 				precedence: (#ifTrue:ifFalse: precedence)
+ 				from: encoder
+ 				sourceRange: nil.
+ 
+ !

Item was added:
+ ----- Method: CompoundTileMorph>>parseNodeWith:asStatement: (in category '*Etoys-Squeakland-code generation') -----
+ parseNodeWith: encoder asStatement: aBoolean
+ 
+ 	^ self parseNodeWith: encoder.
+ !

Item was added:
+ ----- Method: CompoundTileMorph>>removeHighlightFeedback (in category '*Etoys-Squeakland-miscellaneous') -----
+ removeHighlightFeedback
+ 	"Remove any existing highlight feedback"
+ 
+ 	ActiveWorld removeHighlightFeedback.
+ !

Item was added:
+ ----- Method: CompoundTileMorph>>sexpBlockElementsFor:with: (in category '*Etoys-Squeakland-code generation') -----
+ sexpBlockElementsFor: scriptPart with: dictionary
+ 
+ 	| rows r |
+ 	rows _ scriptPart tileRows.
+ 	^ Array streamContents: [:strm |
+ 		1 to: rows size do: [:i |
+ 		r _ rows at: i.
+ 			r do: [:t | strm nextPut: (t sexpWith: dictionary)].
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: CompoundTileMorph>>sexpBlockFor:with: (in category '*Etoys-Squeakland-code generation') -----
+ sexpBlockFor: scriptPart with: dictionary
+ 
+ 	| n elems |
+ 	n _ SExpElement keyword: #sequence.
+ 	elems _ self sexpBlockElementsFor: scriptPart with: dictionary.
+ 	n elements: elems.
+ 	^ n.
+ !

Item was added:
+ ----- Method: CompoundTileMorph>>sexpWith: (in category '*Etoys-Squeakland-code generation') -----
+ sexpWith: dictionary
+ 
+ 	| n elements test |
+ 	n _ SExpElement keyword: #condition.
+ 	test _ self sexpBlockElementsFor: testPart with: dictionary.
+ 	test ifEmpty: [test _ SExpElement keyword: #sequence elements: #()] ifNotEmpty: [test _ test first].
+ 	elements _ Array
+ 		with: test
+ 		with: (self sexpBlockFor: yesPart with: dictionary)
+ 		with: (self sexpBlockFor: noPart with: dictionary).
+ 	^ n elements: elements.
+ !

Item was added:
+ ----- Method: CompoundTileMorph>>testPart (in category '*Etoys-Squeakland-etoys-debugger') -----
+ testPart
+ 	^ testPart!

Item was added:
+ ----- Method: CompoundTileMorph>>unhibernate (in category '*Etoys-Squeakland-initialization') -----
+ unhibernate
+ 
+ 	self labelMorphs do: [:l | l label: l contents font: Preferences standardEToysFont].
+ 	self removeProperty: #needsLayoutFixed.
+ !

Item was added:
+ ----- Method: CompoundTileMorph>>yesPart (in category '*Etoys-Squeakland-etoys-debugger') -----
+ yesPart
+ 	^ yesPart!

Item was added:
+ ----- Method: CompressedSoundData class>>codecName:samplingRate: (in category '*Etoys-Squeakland-instance creation') -----
+ codecName: codecName samplingRate: samplingRate 
+ 	| instance |
+ 	"OggSoundData builds compressed data from here."
+ 	instance := self new.
+ 	instance codecName: codecName.
+ 	instance samplingRate: samplingRate.
+ 	instance soundClassName: #SampledSound.
+ 	instance gain: 1.0.
+ 	^ instance!

Item was added:
+ ----- Method: CompressedSoundData>>codecSignature (in category '*Etoys-Squeakland-accessing') -----
+ codecSignature
+ 	^ self className , ' codecName: ' , codecName printString, ' samplingRate: ' , samplingRate printString!

Item was added:
+ ----- Method: CompressedSoundData>>isCompressed (in category '*Etoys-Squeakland-accessing') -----
+ isCompressed
+ 	^ true!

Item was added:
+ ----- Method: CompressedSoundData>>source: (in category '*Etoys-Squeakland-accessing') -----
+ source: aByteArray
+ 	channels := {aByteArray}.
+ !

Item was added:
+ ----- Method: ConnectionQueue>>oldListenLoop (in category '*Etoys-Squeakland-private') -----
+ oldListenLoop
+ 	"Private!! This loop is run in a separate process. It will establish up to maxQueueLength connections on the given port."
+ 	"Details: When out of sockets or queue is full, retry more frequently, since a socket may become available, space may open in the queue, or a previously queued connection may be aborted by the client, making it available for a fresh connection."
+ 	"Note: If the machine is disconnected from the network while the server is running, the currently waiting socket will go from 'isWaitingForConnection' to 'unconnected', and attempts to create new sockets will fail. When this happens, delete the broken socket and keep trying to create a socket in case the network connection is re-established. Connecting and disconnecting was tested under PPP on Mac system 8.1. It is not if this will work on other platforms."
+ 
+ 
+ 	| newConnection |
+ 	socket _ Socket newTCP.
+ 	"We'll accept four simultanous connections at the same time"
+ 	socket listenOn: self portNumber backlogSize: 4.
+ 	"If the listener is not valid then the we cannot use the
+ 	BSD style accept() mechanism."
+ 	socket isValid ifFalse: [^self oldStyleListenLoop].
+ 	[true] whileTrue: [
+ 		socket isValid ifFalse: [
+ 			"socket has stopped listening for some reason"
+ 			socket destroy.
+ 			(Delay forMilliseconds: 10) wait.
+ 			^self oldListenLoop ].
+ 		newConnection _ socket waitForAcceptFor: 10.
+ 		(newConnection notNil and:[newConnection isConnected]) ifTrue:
+ 			[accessSema critical: [connections addLast: newConnection].
+ 			newConnection _ nil].
+ 		self pruneStaleConnections]. !

Item was added:
+ ----- Method: ControlManager>>interruptName: (in category '*Etoys-Squeakland-scheduling') -----
+ interruptName: labelString
+ 	"Create a Notifier on the active scheduling process with the given label. Make the Notifier the active controller."
+ 
+ 	^ self interruptName: labelString preemptedProcess: nil
+ !

Item was added:
+ ----- Method: ControlManager>>interruptName:preemptedProcess: (in category '*Etoys-Squeakland-scheduling') -----
+ interruptName: labelString preemptedProcess: theInterruptedProcess
+ 	"Create a Notifier on the active scheduling process with the given label. Make the Notifier the active controller."
+ 	| newActiveController preemptedProcess |
+ 
+ 	preemptedProcess := theInterruptedProcess ifNil: [Processor preemptedProcess].
+ 	preemptedProcess suspend.
+ 
+ 	"There is something wrong here. We suspend *two* processes, the interrupted
+ 	process and the activeControllerProcess (unless they are the same). How can
+ 	that possibly be right? However, it is what the code did before I added the comment
+ 	(it was merely hidden underneith another pile of code). Someone with more 
+ 	understanding about MVC fix this please."
+ 
+ 	preemptedProcess == activeControllerProcess 
+ 		ifFalse:[activeControllerProcess suspend].
+ 
+ 	activeController ~~ nil ifTrue: [
+ 		"Carefully de-emphasis the current window."
+ 		activeController view topView deEmphasizeForDebugger].
+ 
+ 	newActiveController :=
+ 		(Debugger
+ 			openInterrupt: labelString
+ 			onProcess: preemptedProcess) controller.
+ 	newActiveController centerCursorInView.
+ 	self activeController: newActiveController.
+ !

Item was added:
+ Object subclass: #CornerRounder
+ 	instanceVariableNames: 'cornerMasks cornerOverlays underBits'
+ 	classVariableNames: 'CR0 CR1 CR2'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Graphics-Display Objects'!
+ 
+ !CornerRounder commentStamp: '<historical>' prior: 0!
+ This class is a quick hack to support rounded corners in morphic.
+ 
+ Rather than produce rounded rectangles, it tweaks the display of corners.
+ Rather than work for any radius, it only supports a radius of 6.
+ Rather than work for any border width, it only supports widths 0, 1 and 2.
+ The corners, while apparently transparent, still behave opaquely to mouse clicks.
+ 
+ Worse than this, the approach relies on the ability to extract underlying bits from the canvas prior to display.  This ran afoul of top-down display, it seems, in SystemWindow spawnReframeHandle: (qv).  It will also make a postscript printer very unhappy.
+ 
+ But, hey, it's cute.!

Item was added:
+ ----- Method: CornerRounder class>>initialize (in category 'all') -----
+ initialize  "CornerRounder initialize"
+ 
+ 	CR0 _ CR1 _ self new
+ 		masterMask:
+ 			(Form extent: 6 at 6
+ 				fromArray: #(2r1e26 2r111e26 2r1111e26 2r11111e26 2r11111e26 2r111111e26)
+ 				offset: 0 at 0)
+ 		masterOverlay:
+ 			(Form extent: 6 at 6
+ 				fromArray: #(2r1e26 2r110e26 2r1000e26 2r10000e26 2r10000e26 2r100000e26)
+ 				offset: 0 at 0).
+ 	CR2 _ self new
+ 		masterMask:
+ 			(Form extent: 6 at 6
+ 				fromArray: #(2r1e26 2r111e26 2r1111e26 2r11111e26 2r11111e26 2r111111e26)
+ 				offset: 0 at 0)
+ 		masterOverlay:
+ 			(Form extent: 6 at 6
+ 				fromArray: #(2r1e26 2r111e26 2r1111e26 2r11100e26 2r11000e26 2r111000e26)
+ 				offset: 0 at 0).
+ 
+ !

Item was added:
+ ----- Method: CornerRounder class>>rectWithinCornersOf: (in category 'all') -----
+ rectWithinCornersOf: aRectangle
+ 	"Return a single sub-rectangle that lies entirely inside corners
+ 	that are made by me.
+ 	Used to identify large regions of window that do not need to be redrawn."
+ 
+ 	^ aRectangle insetBy: 0 at 6!

Item was added:
+ ----- Method: CornerRounder class>>roundCornersOf:on:in:displayBlock:borderWidth:corners: (in category 'all') -----
+ roundCornersOf: aMorph on: aCanvas in: bounds displayBlock: displayBlock borderWidth: w corners: aList
+ 
+ 	| rounder |
+ 	rounder _ CR0.
+ 	w = 1 ifTrue: [rounder _ CR1].
+ 	w = 2 ifTrue: [rounder _ CR2].
+ 	rounder _ rounder copy.
+ 	rounder saveBitsUnderCornersOf: aMorph on: aCanvas in: bounds corners: aList.
+ 	displayBlock value.
+ 	rounder tweakCornersOf: aMorph on: aCanvas in: bounds borderWidth: w corners: aList!

Item was added:
+ ----- Method: CornerRounder>>masterMask:masterOverlay: (in category 'all') -----
+ masterMask: maskForm masterOverlay: overlayForm
+ 
+ 	cornerMasks _ #(none left pi right) collect:
+ 		[:dir | (maskForm rotateBy: dir centerAt: 0 at 0) offset: 0 at 0].
+ 	cornerOverlays _ #(none left pi right) collect:
+ 		[:dir | (overlayForm rotateBy: dir centerAt: 0 at 0) offset: 0 at 0].
+ !

Item was added:
+ ----- Method: CornerRounder>>saveBitsUnderCornersOf:on:in:corners: (in category 'all') -----
+ saveBitsUnderCornersOf: aMorph on: aCanvas in: bounds corners: cornerList
+ 
+ 	| offset corner mask form corners rect |
+ 	underBits _ Array new: 4.
+ 	corners _ bounds corners.
+ 	cornerList do:[:i|
+ 		mask _ cornerMasks at: i.
+ 		corner _ corners at: i.
+ 		i = 1 ifTrue: [offset _ 0 at 0].
+ 		i = 2 ifTrue: [offset _ 0 at mask height negated].
+ 		i = 3 ifTrue: [offset _ mask extent negated].
+ 		i = 4 ifTrue: [offset _ mask width negated at 0].
+ 		rect _ corner + offset extent: mask extent.
+ 		(aCanvas isVisible: rect) ifTrue:[
+ 			form _ aCanvas contentsOfArea: rect.
+ 			form copyBits: form boundingBox from: mask at: 0 at 0 clippingBox: form boundingBox rule: Form and fillColor: nil map: (Bitmap with: 16rFFFFFFFF with: 0).
+ 			underBits at: i put: form]].
+ !

Item was added:
+ ----- Method: CornerRounder>>tweakCornersOf:on:in:borderWidth:corners: (in category 'all') -----
+ tweakCornersOf: aMorph on: aCanvas in: bounds borderWidth: w corners: cornerList
+ 	"This variant has a cornerList argument, to allow some corners to be rounded and others not"
+ 	| offset corner saveBits fourColors mask outBits shadowColor corners |
+ 	shadowColor _ aCanvas shadowColor.
+ 	aCanvas shadowColor: nil. "for tweaking it's essential"
+ 	w > 0 ifTrue:[
+ 			fourColors _ shadowColor 
+ 				ifNil:[aMorph borderStyle colorsAtCorners]
+ 				ifNotNil:[Array new: 4 withAll: Color transparent]].
+ 	mask _ Form extent: cornerMasks first extent depth: aCanvas depth.
+ 	corners _ bounds corners.
+ 	cornerList do:[:i|
+ 		corner _ corners at: i.
+ 		saveBits _ underBits at: i.
+ 		saveBits ifNotNil:[
+ 			i = 1 ifTrue: [offset _ 0 at 0].
+ 			i = 2 ifTrue: [offset _ 0 at saveBits height negated].
+ 			i = 3 ifTrue: [offset _ saveBits extent negated].
+ 			i = 4 ifTrue: [offset _ saveBits width negated at 0].
+ 
+ 			"Mask out corner area (painting saveBits won't clear if transparent)."
+ 			mask copyBits: mask boundingBox from: (cornerMasks at: i) at: 0 at 0 clippingBox: mask boundingBox rule: Form over fillColor: nil map: (Bitmap with: 0 with: 16rFFFFFFFF).
+ 			outBits _ aCanvas contentsOfArea: (corner + offset extent: mask extent).
+ 			mask displayOn: outBits at: 0 at 0 rule: Form and.
+ 			"Paint back corner bits."
+ 			saveBits displayOn: outBits at: 0 at 0 rule: Form paint.
+ 			"Paint back corner bits."
+ 			aCanvas drawImage: outBits at: corner + offset.
+ 
+ 			w > 0 ifTrue:[
+ 				
+ 				aCanvas stencil: (cornerOverlays at: i) at: corner + offset
+ 						color: (fourColors at: i)]]].
+ 	aCanvas shadowColor: shadowColor. "restore shadow color"
+ !

Item was added:
+ WordGamePanelMorph subclass: #CrosticPanel
+ 	instanceVariableNames: 'crosticPanel quotePanel cluesCol2 answers quote clues cluesPanel'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!
+ 
+ !CrosticPanel commentStamp: '<historical>' prior: 0!
+ The CrosticPanel, as its name suggests, is a tool for decoding acrostic puzzles, such as are presented on the puzzle pages of some Sunday newspapers.  Much of the capability is inherited from the two WordGame classes used.  To try it out, choose newMorph/Games/CrosticPanel in a morphic project, or execute, in any project:
+ 
+ 	CrosticPanel new openInWorld
+ 
+ The instance variables of this class include...
+ 	letterMorphs (in superclass)  a collection of all the letterMorphs in this panel
+ 	quote		a string, being the entire quote in uppercase with no blanks
+ 	clues		a collection of the clue strings
+ 	answers		a collection of the answer indices.
+ 				For each answer, this is an array of the indices into the quote string.
+ 
+ The final structure of a CrosticPanel is as follows
+ 	self					a CrosticPanel			the overall holder
+ 		quotePanel		a CrosticQuotePanel		holds the grid of letters from the quote
+ 		cluesPanel		an AlignmentMorph		holds most of the clue rows
+ 		cluesCol2		an AlignmentMorph		holds the rest of the clue rows
+ 
+ Each clue row is a horizontal AlignmentMorph with a textMorph and another alignmentMorph full of the letterMorphs for the answer.
+ !

Item was added:
+ ----- Method: CrosticPanel class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName:	'Crostic' translatedNoop
+ 		categories:		{'Games' translatedNoop}
+ 		documentation:	'The Crostic Panel: A classic word diagram game, by Dan Ingalls' translatedNoop!

Item was added:
+ ----- Method: CrosticPanel class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 
+ 	^ true!

Item was added:
+ ----- Method: CrosticPanel class>>new (in category 'instance creation') -----
+ new
+ 	"NOTE: Use newFromFile: rather than new to create new CrosticPanels"
+ 
+ 	^ self newFromFile: (ReadStream on: self sampleFile)!

Item was added:
+ ----- Method: CrosticPanel class>>newFromFile: (in category 'instance creation') -----
+ newFromFile: aStream 
+ 	"World addMorph: CrosticPanel new"
+ 	"World addMorph: (CrosticPanel newFromFile: (FileStream 
+ 	readOnlyFileNamed: 'first.crostic'))"
+ 	| quoteWithBlanks citation clue numberLine numbers clues answers indexableQuote quotePanel crosticPanel buttonRow quoteWidth |
+ 	aStream next asciiValue = 31 & (aStream next asciiValue = 139)
+ 		ifTrue: ["It's gzipped..."
+ 			aStream skip: -2.
+ 			^ self newFromFile: aStream asUnZippedStream ascii].
+ 	aStream skip: -2.
+ 	quoteWithBlanks := aStream nextLine.
+ 	quoteWithBlanks := quoteWithBlanks asUppercase
+ 				select: [:c | c isLetter
+ 						or: [' -' includes: c]].
+ 	indexableQuote := quoteWithBlanks
+ 				select: [:c | c isLetter].
+ 	citation := aStream nextLine.
+ 	aStream nextLine.
+ 	clues := OrderedCollection new.
+ 	answers := OrderedCollection new.
+ 	[aStream atEnd]
+ 		whileFalse: [clue := aStream nextLine.
+ 			"Transcript cr; show: clue."
+ 			clues addLast: clue.
+ 			numberLine := aStream nextLine.
+ 			numbers := Scanner new scanTokens: numberLine.
+ 			answers addLast: numbers].
+ 	aStream close.
+ 	"Consistency check:"
+ 	(citation asUppercase
+ 			select: [:c | c isLetter])
+ 			= (String
+ 					withAll: (answers
+ 							collect: [:a | indexableQuote at: a first]))
+ 		ifFalse: [self error: 'mal-formed crostic file' translated].
+ 	crosticPanel := super new.
+ 	quotePanel := CrosticQuotePanel new
+ 				quote: quoteWithBlanks
+ 				answers: answers
+ 				cluesPanel: crosticPanel.
+ 	crosticPanel color: quotePanel firstSubmorph color;
+ 		
+ 		quote: indexableQuote
+ 		clues: clues
+ 		answers: answers
+ 		quotePanel: quotePanel.
+ 	buttonRow := crosticPanel buttonRow.
+ 	quoteWidth := crosticPanel width + quotePanel firstSubmorph width max: buttonRow width.
+ 	quotePanel extent: quoteWidth @ 9999.
+ 	crosticPanel addMorph: quotePanel.
+ 	^ crosticPanel breakColumnAndResizeWithButtons: buttonRow!

Item was added:
+ ----- Method: CrosticPanel class>>oldStyle (in category 'as yet unclassified') -----
+ oldStyle
+ 	"return true if we should cross-index all the cells (takes more space)."
+ 
+ 	^ false!

Item was added:
+ ----- Method: CrosticPanel class>>sampleFile (in category 'as yet unclassified') -----
+ sampleFile 
+ 	"If you want to enter a new acrostic, follow this format exactly with regard to CRs and the like, and store it in a file.  Do not double the string quotes as here -- that is only because they are embedded in a string.  Finally, compress the file in the fileList (so it will be easy to transport and hard to read), and name it 'yourName.crostic' so that the 'open' button on the panel will recognize it."
+ 	^
+ 'Men and women do not feel the same way about dirt.  Women for some hormonal reason can see individual dirt molecules, whereas men tend not to notice them until they join together into clumps large enough to support commercial agriculture.
+ Dave Barry''s Guide to Marriage
+ 
+ Boccaccio''s collection of tales
+ 74 19 175 156 9 122 84 113 104
+ Wooden instrument of Swiss herders
+ 67 184 153 103 14 142 148 54 3
+ Evening service
+ 76 99 154 171 89 194 69
+ Russian-born American anarchist (2 wds)
+ 159 102 177 25 186 134 128 82 50 62 11
+ Apple-polish (2 wds)
+ 32 190 129 126 179 157 79 170
+ Visual-gesture means of communication
+ 4 178 27 168 150 185 114
+ Postponed contest
+ 173 58 77 65 8 124 85
+ Groundbreaking invention
+ 98 15 116 162 112 37 92 155 70 187
+ Material used to make English longbows
+ 132 195 28
+ Gracile
+ 48 191 145 152
+ Have the effrontery; experience a high (2 wds)
+ 164 61 137 33 17 45
+ Florentine painter who experimented with perspective
+ 91 181 189 2 20 81 167
+ Sondheim opus (3 wds)
+ 72 109 147 13 192 165 93 40 115 138 6 63
+ Spanish rake
+ 108 56 44 133 193 29 125
+ Emergence  as of an adult butterfly
+ 106 149 59 41 24 135 87 68
+ Type of rifle (hyph)
+ 111 7 143 73 39 30 105 95 53
+ Free of charge (3 wds)
+ 176 107 120 130 160 22 46 34 94 71
+ Pie filling
+ 86 75 136 118 43
+ Master filmmaker
+ 31 151 174 51 163 144
+ Longtime sportswriter for the NY Herald tribune (2 wds)
+ 60 140 12 101 55 188 166 121
+ Birthplace of Erasmus
+ 47 64 141 21 10 180 36 80 1
+ Mae West classic (3 wds)
+ 127 123 161 110 183 5 139 97 88
+ Element that glows blue in the dark
+ 100 90 35 182 146 117 169 26
+ Sturm und Drang writer
+ 158 172 119 16 52 23
+ Starfish or sea cucumber
+ 18 66 96 83 57 49 78 131 38 42
+ '!

Item was added:
+ ----- Method: CrosticPanel>>addMenuItemsTo:hand: (in category 'menu') -----
+ addMenuItemsTo: aMenu hand: aHandMorph 
+ 	aMenu
+ 		add: 'show crostic help' translated
+ 		target: self
+ 		action: #showHelpWindow.
+ 	aMenu
+ 		add: 'show crostic hints' translated
+ 		target: self
+ 		action: #showHintsWindow.
+ 	aMenu
+ 		add: 'show crostic errors' translated
+ 		target: self
+ 		action: #showErrors.
+ 	aMenu
+ 		add: 'clear crostic typing' translated
+ 		target: self
+ 		action: #clearTyping.
+ 	aMenu
+ 		add: 'open crostic file...' translated
+ 		target: self
+ 		action: #openFile!

Item was added:
+ ----- Method: CrosticPanel>>breakColumnAndResizeWithButtons: (in category 'initialization') -----
+ breakColumnAndResizeWithButtons: buttonRow
+ 	| indexToSplit yToSplit |
+ 	"The column of clues has been laid out, and the crostic panel has been resized to that width and embedded as a submorph.  This method breaks the clues in two, placing the long part to the left of the crostic and the short one below it."
+ 
+ 	yToSplit _ cluesPanel height + quotePanel height // 2 + self top.
+ 	indexToSplit _ cluesPanel submorphs findFirst: [:m | m bottom > yToSplit].
+ 	cluesCol2 _ AlignmentMorph newColumn color: self color;
+ 		hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 0;
+ 		cellPositioning: #topLeft.
+ 	cluesCol2 addAllMorphs: (cluesPanel submorphs copyFrom: indexToSplit + 1
+ 							to: cluesPanel submorphs size).
+ 	cluesPanel position: self position + self borderWidth + (0 @ 4).
+ 	quotePanel position: self position + (quotePanel width @ 0).
+ 	cluesCol2 position: self position + quotePanel extent + (0 @ 4).
+ 	self addMorph: cluesCol2.
+ 	self addMorph: buttonRow.
+ 	buttonRow align: buttonRow topLeft with: cluesCol2 bottomLeft.
+ 	self extent: 100 at 100; bounds: ((self fullBounds topLeft - self borderWidth asPoint)
+ 							corner: (self fullBounds bottomRight - (2 at 0))).
+ !

Item was added:
+ ----- Method: CrosticPanel>>buttonRow (in category 'menu') -----
+ buttonRow
+ 	| row aButton |
+ 	row := AlignmentMorph newRow color: self color;
+ 				 hResizing: #shrinkWrap;
+ 				 vResizing: #shrinkWrap.
+ 	#('show help' 'show errors' 'show hints' 'clear' 'open...' ) translatedNoop
+ 		with: #(#showHelpWindow #showErrors #showHintsWindow #clearTyping #openFile )
+ 		do: [:label :selector | 
+ 			aButton := SimpleButtonMorph new target: self.
+ 			aButton color: Color transparent;
+ 				 borderWidth: 1;
+ 				 borderColor: Color black.
+ 			aButton actionSelector: selector.
+ 			aButton label: label translated.
+ 			row addMorphBack: aButton.
+ 			row addTransparentSpacerOfSize: 3 @ 0].
+ 	^ row!

Item was added:
+ ----- Method: CrosticPanel>>clearTyping (in category 'defaults') -----
+ clearTyping
+ 	self isClean
+ 		ifTrue: [^ self].
+ 	(self confirm: 'Are you sure you want to discard all typing?' translated)
+ 		ifFalse: [^ self].
+ 	super clearTyping.
+ 	quotePanel clearTyping!

Item was added:
+ ----- Method: CrosticPanel>>highlight: (in category 'defaults') -----
+ highlight: morph
+ 
+ 	self unhighlight.
+ 	quotePanel unhighlight.
+ 	morph startOfWord morphsInWordDo:
+ 		[:m | m color: Color lightGreen.
+ 		(quotePanel letterMorphs at: m indexInQuote) color: Color lightMagenta].
+ 	morph color: Color green.
+ 	(quotePanel letterMorphs at: morph indexInQuote) color: Color magenta.
+ !

Item was added:
+ ----- Method: CrosticPanel>>initializeToStandAlone (in category 'parts bin') -----
+ initializeToStandAlone
+ 	| aStream quoteWithBlanks indexableQuote citation clue numberLine numbers buttonRow quoteWidth |
+ 	super initializeToStandAlone.
+ 	aStream := ReadStream on: self class sampleFile.
+ 	quoteWithBlanks := aStream nextLine.
+ 	quoteWithBlanks := quoteWithBlanks asUppercase
+ 				select: [:c | c isLetter
+ 						or: [' -' includes: c]].
+ 	indexableQuote := quoteWithBlanks
+ 				select: [:c | c isLetter].
+ 	citation := aStream nextLine.
+ 	aStream nextLine.
+ 	clues := OrderedCollection new.
+ 	answers := OrderedCollection new.
+ 	[aStream atEnd]
+ 		whileFalse: [clue := aStream nextLine.
+ 			"Transcript cr; show: clue."
+ 			clues addLast: clue.
+ 			numberLine := aStream nextLine.
+ 			numbers := Scanner new scanTokens: numberLine.
+ 			answers addLast: numbers].
+ 	aStream close.
+ 	"Consistency check:"
+ 	(citation asUppercase
+ 			select: [:c | c isLetter])
+ 			= (String
+ 					withAll: (answers
+ 							collect: [:a | indexableQuote at: a first]))
+ 		ifFalse: [self error: 'mal-formed crostic file' translated].
+ 	quotePanel := CrosticQuotePanel new
+ 				quote: quoteWithBlanks
+ 				answers: answers
+ 				cluesPanel: self.
+ 	self color: quotePanel firstSubmorph color;
+ 		
+ 		quote: indexableQuote
+ 		clues: clues
+ 		answers: answers
+ 		quotePanel: quotePanel.
+ 	buttonRow := self buttonRow.
+ 	quoteWidth := self width + quotePanel firstSubmorph width max: buttonRow width.
+ 	quotePanel extent: quoteWidth @ 9999.
+ 	self addMorph: quotePanel.
+ 	self breakColumnAndResizeWithButtons: buttonRow!

Item was added:
+ ----- Method: CrosticPanel>>keyCharacter:atIndex:nextFocus: (in category 'defaults') -----
+ keyCharacter: aLetter atIndex: indexInQuote nextFocus: nextFocus
+ 
+ 	(self letterMorphs at: indexInQuote) setLetter: aLetter.
+ 	(quotePanel letterMorphs at: indexInQuote) setLetter: aLetter.
+ 	self highlight: nextFocus
+ !

Item was added:
+ ----- Method: CrosticPanel>>lostFocus (in category 'defaults') -----
+ lostFocus
+ 
+ 	self unhighlight.
+ 	quotePanel unhighlight!

Item was added:
+ ----- Method: CrosticPanel>>openFile (in category 'menu') -----
+ openFile
+ 	| stdFileMenuResult crostic file |
+ 	stdFileMenuResult := (StandardFileMenu new pattern: '*.crostic';
+ 				 oldFileFrom: FileDirectory default) startUpWithCaption: 'Select a Crostic File...' translated.
+ 	stdFileMenuResult
+ 		ifNil: [^ nil].
+ 	file := stdFileMenuResult directory readOnlyFileNamed: stdFileMenuResult name.
+ 	crostic := CrosticPanel newFromFile: file.
+ 	file close.
+ 	(self isClean
+ 			or: [self confirm: 'Is it OK to discard this crostic?' translated])
+ 		ifTrue: [self world
+ 				addMorphFront: (crostic position: self position).
+ 			self delete]
+ 		ifFalse: [self world addMorphFront: crostic]!

Item was added:
+ ----- Method: CrosticPanel>>quote:clues:answers:quotePanel: (in category 'initialization') -----
+ quote: indexableQuote clues: clueStrings answers: answerIndices quotePanel: panel
+ 
+ 	| row clue answer answerMorph letterMorph prev clueText clueStyle |
+ 	quote _ indexableQuote.
+ 	quotePanel _ panel.
+ 	clues _ clueStrings.
+ 	answers _ answerIndices.
+ 	cluesPanel _ AlignmentMorph newColumn color: self color;
+ 		hResizing: #shrinkWrap; vResizing: #shrinkWrap;
+ 		cellPositioning: #topLeft; layoutInset: 1.
+ 	letterMorphs _ Array new: quotePanel letterMorphs size.
+ 	clueStyle _ nil.
+ 	1 to: clues size do:
+ 		[:i |  clue _ clues at: i.  answer _ answers at: i.
+ 		row _ AlignmentMorph newRow cellPositioning: #bottomLeft.
+ 		clueText _ (TextMorph newBounds: (0 at 0 extent: 120 at 20) color: Color black)
+ 				string: (CrosticPanel oldStyle
+ 							ifTrue: [(($A to: $Z) at: i) asString , '.  ' , clue]
+ 							ifFalse: [clue])
+ 				fontName: 'ComicPlain' size: 13.
+ 		clueStyle ifNil: ["Make up a special style with decreased leading"
+ 						clueStyle _ clueText textStyle copy.
+ 						clueStyle gridForFont: 1 withLead: -2].
+ 		clueText text: clueText asText textStyle: clueStyle.  "All clues share same style"
+ 		clueText composeToBounds.
+ 		row addMorphBack: clueText.
+ 		answerMorph _ AlignmentMorph newRow layoutInset: 0.
+ 		prev _ nil.
+ 		answer do:
+ 			[:n | letterMorph _ WordGameLetterMorph new underlined
+ 						indexInQuote: n
+ 						id1: (CrosticPanel oldStyle ifTrue: [n printString] ifFalse: [nil]);
+ 						setLetter: Character space.
+ 			letterMorph on: #mouseDown send: #mouseDownEvent:letterMorph: to: self.
+ 			letterMorph on: #keyStroke send: #keyStrokeEvent:letterMorph: to: self.
+ 			letterMorph predecessor: prev.
+ 			prev ifNotNil: [prev successor: letterMorph].
+ 			prev _ letterMorph.
+ 			letterMorphs at: n put: letterMorph.
+ 			answerMorph addMorphBack: letterMorph].
+ 		answerMorph color: answerMorph firstSubmorph color.
+ 		row addMorphBack: answerMorph.
+ row fullBounds.
+ 		row color: answerMorph firstSubmorph color.
+ 		cluesPanel addMorphBack: row].
+ 	self addMorph: cluesPanel.
+ 	self bounds: cluesPanel fullBounds.
+ !

Item was added:
+ ----- Method: CrosticPanel>>showErrors (in category 'menu') -----
+ showErrors
+ 
+ 	letterMorphs do:
+ 		[:m | (m letter ~= Character space and: [m letter ~= (quote at: m indexInQuote)])
+ 			ifTrue: [m color: Color red.
+ 					(quotePanel letterMorphs at: m indexInQuote) color: Color red]]!

Item was added:
+ ----- Method: CrosticPanel>>showHelpWindow (in category 'menu') -----
+ showHelpWindow
+ 	((StringHolder new contents: 'The Crostic Panel presents an acrostic puzzle for solution.  As you type in answers for the clues, the letters also get entered in the text of the hidden quote.  Conversely, as you guess words in the quote, those letters will fill in missing places in your answers.  In addition, the first letters of all the answers together form the author''s name and title of the work from which the quote is taken.
+ 
+ If you wish to make up other acrostic puzzles, follow the obvious file format in the sampleFile method.  If you wish to print an acrostic to work it on paper, then change the oldStyle method to return true, and it will properly cross-index all the cells.
+ 
+ Have fun.' translated)
+ 		embeddedInMorphicWindowLabeled: 'About the Crostic Panel' translated)
+ 		setWindowColor: (Color
+ 				r: 1.0
+ 				g: 0.6
+ 				b: 0.0);
+ 		 openInWorld: self world extent: 409 @ 207!

Item was added:
+ ----- Method: CrosticPanel>>showHintsWindow (in category 'menu') -----
+ showHintsWindow
+ 	| hints |
+ 	(self confirm: 'As hints, you will be given the five longest answers.
+ Do you really want to do this?' translated)
+ 		ifFalse: [^ self].
+ 	hints := (answers
+ 				asSortedCollection: [:x :y | x size > y size]) asArray copyFrom: 1 to: 5.
+ 	((StringHolder new contents: 'The five longest answers are...
+ ' translated
+ 			, (String
+ 					streamContents: [:strm | 
+ 						hints
+ 							do: [:hint | strm cr;
+ 									nextPutAll: (hint
+ 											collect: [:i | quote at: i])].
+ 						strm cr; cr]) , 'Good luck!!' translated)
+ 		embeddedInMorphicWindowLabeled: 'Crostic Hints' translated)
+ 		setWindowColor: (Color
+ 				r: 1.0
+ 				g: 0.6
+ 				b: 0.0);
+ 		 openInWorld: self world extent: 198 @ 154!

Item was added:
+ WordGamePanelMorph subclass: #CrosticQuotePanel
+ 	instanceVariableNames: 'cluesPanel'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!

Item was added:
+ ----- Method: CrosticQuotePanel>>extent: (in category 'geometry') -----
+ extent: newExtent
+ 
+ 	| w h nAcross relLoc topLeft |
+ 	w _ self firstSubmorph width - 1.  h _ self firstSubmorph height - 1.
+ 	nAcross _ newExtent x - (self borderWidth-1*2)-1 // w.
+ 	topLeft _ self position + self borderWidth - 1.
+ 	submorphs withIndexDo:
+ 		[:m :i | 
+ 		relLoc _ (i-1 \\ nAcross * w) @ (i-1 // nAcross * h).
+ 		m position: topLeft + relLoc].
+ 	super extent: ((w * nAcross + 1) @ (submorphs size - 1 // nAcross + 1 * h+1))
+ 					+ (self borderWidth - 1 * 2).
+ !

Item was added:
+ ----- Method: CrosticQuotePanel>>highlight: (in category 'defaults') -----
+ highlight: morph
+ 
+ 	self unhighlight.
+ 	cluesPanel unhighlight.
+ 	morph startOfWord morphsInWordDo:
+ 		[:m | m color: Color lightGreen.
+ 		(cluesPanel letterMorphs at: m indexInQuote) color: Color lightMagenta].
+ 	morph color: Color green.
+ 	(cluesPanel letterMorphs at: morph indexInQuote) color: Color magenta.
+ !

Item was added:
+ ----- Method: CrosticQuotePanel>>keyCharacter:atIndex:nextFocus: (in category 'defaults') -----
+ keyCharacter: aLetter atIndex: indexInQuote nextFocus: nextFocus
+ 
+ 	(self letterMorphs at: indexInQuote) setLetter: aLetter.
+ 	(cluesPanel letterMorphs at: indexInQuote) setLetter: aLetter.
+ 	self highlight: nextFocus
+ !

Item was added:
+ ----- Method: CrosticQuotePanel>>lostFocus (in category 'defaults') -----
+ lostFocus
+ 
+ 	self unhighlight.
+ 	cluesPanel unhighlight!

Item was added:
+ ----- Method: CrosticQuotePanel>>quote:answers:cluesPanel: (in category 'initialization') -----
+ quote: quoteWithBlanks answers: theAnswers cluesPanel: panel
+ 
+ 	| n morph prev clueIxs |
+ 	cluesPanel _ panel.
+ 	self color: Color gray.
+ 	clueIxs _ Array new: quoteWithBlanks size.
+ 	theAnswers withIndexDo: [:a :i | a do: [:j | clueIxs at: j put: i]].
+ 	letterMorphs _ OrderedCollection new.
+ 	prev _ nil.
+ 	self addAllMorphs: (quoteWithBlanks asArray collect:
+ 		[:c |
+ 		c isLetter
+ 			ifTrue: [n _ letterMorphs size + 1.
+ 					morph _ WordGameLetterMorph new boxed.
+ 					CrosticPanel oldStyle
+ 						ifTrue: [morph indexInQuote: n id1: n printString.
+ 								morph id2: (($A to: $Z) at: (clueIxs at: n)) asString]
+ 						ifFalse: [morph indexInQuote: n id1: nil].
+ 					morph setLetter: Character space.
+ 					morph on: #mouseDown send: #mouseDownEvent:letterMorph: to: self.
+ 					morph on: #keyStroke send: #keyStrokeEvent:letterMorph: to: self.
+ 					letterMorphs addLast: morph]
+ 			ifFalse: [morph _ WordGameLetterMorph new boxed indexInQuote: nil id1: nil.
+ 					CrosticPanel oldStyle ifTrue: [morph extent: 26 at 24  "Oops"]].
+ 		morph predecessor: prev.
+ 		prev ifNotNil: [prev successor: morph].
+ 		prev _ morph]).
+ !

Item was added:
+ Object subclass: #CurrentProjectRefactoring
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Support'!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>currentAddGuard: (in category 'revectoring to current') -----
+ currentAddGuard: anObject
+ "
+ CurrentProjectRefactoring currentAddGuard:
+ "
+ 	^self xxxCurrent addGuard: anObject!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>currentBeIsolated (in category 'revectoring to current') -----
+ currentBeIsolated
+ "
+ CurrentProjectRefactoring currentBeIsolated
+ "
+ 	^self xxxCurrent beIsolated!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>currentBeParentTo: (in category 'revectoring to current') -----
+ currentBeParentTo: anotherProject
+ "
+ CurrentProjectRefactoring currentBeParentTo:
+ "
+ 	^anotherProject setParent: self xxxCurrent!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>currentBeParentToCurrent (in category 'revectoring to current') -----
+ currentBeParentToCurrent
+ "
+ CurrentProjectRefactoring currentBeParentToCurrent
+ "
+ 	^self xxxCurrent setParent: self xxxCurrent!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>currentFlapsSuppressed (in category 'revectoring to current') -----
+ currentFlapsSuppressed
+ "
+ CurrentProjectRefactoring currentFlapsSuppressed
+ "
+ 	^self xxxCurrent flapsSuppressed!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>currentFromMyServerLoad: (in category 'revectoring to current') -----
+ currentFromMyServerLoad: aProjectName
+ "
+ CurrentProjectRefactoring currentFromMyServerLoad:
+ "
+ 	^self xxxCurrent fromMyServerLoad: aProjectName!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>currentInterruptName: (in category 'revectoring to current') -----
+ currentInterruptName: aString
+ "
+ CurrentProjectRefactoring currentInterruptName:
+ "
+ 	^Project interruptName: aString!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>currentInterruptName:preemptedProcess: (in category 'revectoring to current') -----
+ currentInterruptName: aString preemptedProcess: theInterruptedProcess
+ 
+ 	^ Project interruptName: aString preemptedProcess: theInterruptedProcess!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>currentIsolationHead (in category 'revectoring to current') -----
+ currentIsolationHead
+ "
+ CurrentProjectRefactoring currentIsolationHead
+ "
+ 	^self xxxCurrent isolationHead!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>currentProjectName (in category 'revectoring to current') -----
+ currentProjectName
+ "
+ CurrentProjectRefactoring currentProjectName
+ "
+ 	^self xxxCurrent name!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>currentPropagateChanges (in category 'revectoring to current') -----
+ currentPropagateChanges
+ "
+ CurrentProjectRefactoring currentPropagateChanges
+ "
+ 	^self xxxCurrent propagateChanges!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>currentSpawnNewProcessAndTerminateOld: (in category 'revectoring to current') -----
+ currentSpawnNewProcessAndTerminateOld: aBoolean
+ "
+ CurrentProjectRefactoring currentSpawnNewProcessAndTerminateOld:
+ "
+ 	^Project spawnNewProcessAndTerminateOld: aBoolean
+ 
+ !

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>currentToggleFlapsSuppressed (in category 'revectoring to current') -----
+ currentToggleFlapsSuppressed
+ "
+ CurrentProjectRefactoring currentToggleFlapsSuppressed
+ "
+ 	^self xxxCurrent flapsSuppressed: self xxxCurrent flapsSuppressed not.
+ 
+ 
+ !

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>exitCurrentProject (in category 'miscellaneous') -----
+ exitCurrentProject
+ "
+ CurrentProjectRefactoring exitCurrentProject
+ "
+ 	^self xxxCurrent exit
+ !

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>isFlapEnabled: (in category 'flaps') -----
+ isFlapEnabled: aFlapTab
+ 	"Answer whether the given flap tab is enabled in the current project"
+ 
+ 	^ self xxxCurrent isFlapEnabled: aFlapTab!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>newProcessIfUI: (in category 'miscellaneous') -----
+ newProcessIfUI: aDeadOrDyingProcess
+ "
+ CurrentProjectRefactoring newProcessIfUI:
+ used ONLY for Morphic
+ "
+ 	^Project spawnNewProcessIfThisIsUI: aDeadOrDyingProcess!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>projectWithNameOrCurrent: (in category 'miscellaneous') -----
+ projectWithNameOrCurrent: aString
+ "
+ CurrentProjectRefactoring projectWithNameOrCurrent:
+ "
+ 	^(Project named: aString) ifNil: [self xxxCurrent]!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>showSharedFlaps (in category 'flaps') -----
+ showSharedFlaps
+ 	"Answer whether shared flaps are currently showing (true) or suppressed (false).  The CurrentProjectRefactoring circumlocution is in service of making it possible for shared flaps to appear on the edges of an interior subworld, I believe."
+ 
+ 	^ self xxxCurrent showSharedFlaps!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>showTabsString (in category 'flaps') -----
+ showTabsString
+ 	"Answer a string characterizing whether global flap tabs are showing (true) or suppressed (false)."
+ 
+ 	^ (self currentFlapsSuppressed
+ 		ifTrue: ['<no>']
+ 		ifFalse: ['<yes>']), 'show flaps (F)' translated!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>suppressFlapsString (in category 'flaps') -----
+ suppressFlapsString
+ 	"Answer a string characterizing whether flaps are suppressed 
+ 	at the moment or not"
+ 	^ (self currentFlapsSuppressed
+ 		ifTrue: ['<no>']
+ 		ifFalse: ['<yes>']), 'show shared tabs (F)' translated!

Item was added:
+ ----- Method: CurrentProjectRefactoring class>>xxxCurrent (in category 'revectoring to current') -----
+ xxxCurrent
+ 
+ 	^Project current!

Item was added:
+ ----- Method: Cursor class>>loadFromXCursorFileNamed: (in category '*Etoys-Squeakland-instance creation') -----
+ loadFromXCursorFileNamed: aString
+ 	"Load an ARGB cursor from an XCursor file"
+ 
+ 	| f |
+ 	f := FileStream readOnlyFileNamed: aString.
+ 	^[self loadFromXCursorStream: f binary upToEnd readStream]
+ 		ensure: [f close]!

Item was added:
+ ----- Method: Cursor class>>loadFromXCursorStream: (in category '*Etoys-Squeakland-instance creation') -----
+ loadFromXCursorStream: aStream
+ 	"Load an ARGB cursor from an XCursor file (see bottom for spec)"
+ 
+ 	| headerBytes imgPos cursor |
+ 	aStream reset.
+ 	(aStream nextLittleEndianNumber: 4) = 16r72756358 ifFalse: [^self error: 'not an Xcursor file'].
+ 	headerBytes := aStream nextLittleEndianNumber: 4.
+ 	aStream position: headerBytes + 8. "position field of first TOC entry"
+ 	imgPos := aStream nextLittleEndianNumber: 4.
+ 	aStream position: imgPos + 16.
+ 	cursor := Cursor extent: (aStream nextLittleEndianNumber: 4) 
+ 		@ (aStream nextLittleEndianNumber: 4)
+ 		depth: 32.
+ 	cursor offset: (aStream nextLittleEndianNumber: 4) negated
+ 		@ (aStream nextLittleEndianNumber: 4) negated.
+ 	aStream skip: 4. "ignore delay"
+ 	(Form new hackBits: (aStream next: cursor width*cursor height*4))
+ 		displayOn: (Form new hackBits: cursor bits).
+ 	^cursor
+ 
+ "From Xcursor man page:
+ 
+ Xcursor defines a new format for cursors on disk. Each file holds one or more cursor images. Each cursor image is tagged with a nominal size so that the best size can be selected automatically. Multiple cursors of the same nominal size can be loaded together; applications are expected to use them as an animated sequence.
+ 
+ Cursor files are stored as a header containing a table of contents followed by a sequence of chunks. The table of contents indicates the type, subtype and position in the file of each chunk. The file header looks like:
+ 
+ magic: CARD32 'Xcur' (0x58, 0x63, 0x75, 0x72)
+ header: CARD32 bytes in this header
+ version: CARD32 file version number
+ ntoc: CARD32 number of toc entries toc: LISTofTOC table of contents
+ 
+ Each table of contents entry looks like:
+ 
+ type: CARD32 entry type subtype: CARD32 type-specific label - size for images position: CARD32 absolute byte position of table in file
+ 
+ Each chunk in the file has set of common header fields followed by additional type-specific fields:
+ 
+ header: CARD32 bytes in chunk header (including type-specific fields)
+ type: CARD32 must match type in TOC for this chunk
+ subtype: CARD32 must match subtype in TOC for this chunk
+ version: CARD32 version number for this chunk type
+ 
+ There are currently two chunk types defined for cursor files; comments and images. Comments look like:
+ 
+ header: 20 Comment headers are 20 bytes
+ type: 0xfffe0001 Comment type is 0xfffe0001
+ subtype: { 1 (COPYRIGHT), 2 (LICENSE), 3 (OTHER) }
+ version: 1
+ length: CARD32 byte length of UTF-8 string
+ string: LISTofCARD8 UTF-8 string
+ 
+ Images look like:
+ 
+ header: 36 Image headers are 36 bytes
+ type: 0xfffd0002 Image type is 0xfffd0002
+ subtype: CARD32 Image subtype is the nominal size
+ version: 1
+ width: CARD32 Must be less than or equal to 0x7fff
+ height: CARD32 Must be less than or equal to 0x7fff
+ xhot: CARD32 Must be less than or equal to width
+ yhot: CARD32 Must be less than or equal to height
+ delay: CARD32 Delay between animation frames in milliseconds
+ pixels: LISTofCARD32 Packed ARGB format pixels
+ "!

Item was added:
+ ----- Method: Cursor>>primBeCursor (in category '*Etoys-Squeakland-primitives') -----
+ primBeCursor
+ 	<primitive: 101>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: CursorWithAlpha>>primBeCursor (in category '*Etoys-Squeakland-primitives') -----
+ primBeCursor
+ 	<primitive: 101>
+ 	self fallback primBeCursor!

Item was added:
+ ----- Method: CurveMorph class>>formerDescriptionForPartsBin (in category '*Etoys-Squeakland-parts bin') -----
+ formerDescriptionForPartsBin
+ 	"Formerly, the definition that resulted in there being a Curve in the objects catalog, etc.  We now use a generic PolygonMorph, configured to be curve-like, instead..."
+ 
+ 	^ self partName:	'Curve' translatedNoop
+ 		categories:		{'Graphics' translatedNoop. 'Basic' translatedNoop}
+ 		documentation:	'A smooth wiggly curve, or a curved solid.  Shift-click to get handles and move the points.  Using the halo menu, can be coverted into a polygon, and can be made "open" rather than closed.' translatedNoop!

Item was added:
+ HtmlFormatter subclass: #DHtmlFormatter
+ 	instanceVariableNames: 'fontSpecs'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Formatter'!
+ 
+ !DHtmlFormatter commentStamp: '<historical>' prior: 0!
+ an attempt to improve HtmlFormatter...
+ make it a bit more DOMish (eventually)
+ 
+ roadmap
+ -1-	support for font specs (color, size)
+ -2-	support for tabless!

Item was added:
+ ----- Method: DHtmlFormatter>>decreaseFontBy: (in category 'formatting commands') -----
+ decreaseFontBy: relSize
+ 	self startFont: (TextFontChange fontNumber: ((self lastFontSize - relSize) min: 4))!

Item was added:
+ ----- Method: DHtmlFormatter>>endFont: (in category 'formatting commands') -----
+ endFont: aFont
+ 	fontSpecs isEmptyOrNil
+ 		ifFalse: [fontSpecs removeLast].
+ 	self setAttributes!

Item was added:
+ ----- Method: DHtmlFormatter>>endHeader: (in category 'formatting commands') -----
+ endHeader: level
+ 	boldLevel _ boldLevel - 1. "self decreaseBold"
+ 	self ensureNewlines: 2.
+ 	self endFont: nil.!

Item was added:
+ ----- Method: DHtmlFormatter>>headerFont: (in category 'formatting commands') -----
+ headerFont: level
+ 	^{TextFontChange fontNumber: ((5 - level) max: 1)}!

Item was added:
+ ----- Method: DHtmlFormatter>>increaseFontBy: (in category 'formatting commands') -----
+ increaseFontBy: relSize
+ 	self startFont: (TextFontChange fontNumber: ((self lastFontSize + relSize) min: 4))!

Item was added:
+ ----- Method: DHtmlFormatter>>lastFontSize (in category 'formatting commands') -----
+ lastFontSize
+ 	| textAttrib |
+ 	fontSpecs isEmptyOrNil ifTrue: [^1].
+ 
+ 	fontSpecs reverseDo: [:specs |
+ 		textAttrib _ specs detect: [:attrib | attrib isKindOf: TextFontChange] ifNone: [].
+ 		textAttrib ifNotNil: [^textAttrib fontNumber]].
+ 
+ 	^1 "default font size in Squeak (1) corresponds to HTML's default 4"!

Item was added:
+ ----- Method: DHtmlFormatter>>resetFont (in category 'formatting commands') -----
+ resetFont
+ 	"probably need use document defaults"
+ 	self startFont:
+ 		{TextColor black.
+ 		TextFontChange fontNumber: 1}!

Item was added:
+ ----- Method: DHtmlFormatter>>setAttributes (in category 'private-formatting') -----
+ setAttributes
+ 	"set attributes on the output stream"
+ 	| attribs |
+ 	attribs _ OrderedCollection new.
+ 	indentLevel > 0 ifTrue: [ attribs add: (TextIndent tabs: indentLevel) ].
+ 	boldLevel > 0 ifTrue: [ attribs add: TextEmphasis bold ].
+ 	italicsLevel >  0 ifTrue: [ attribs add: TextEmphasis italic ].
+ 	underlineLevel > 0 ifTrue: [ attribs add: TextEmphasis underlined ].
+ 	strikeLevel > 0 ifTrue: [ attribs add: TextEmphasis struckOut ].
+ 	urlLink isNil ifFalse: [ attribs add: (TextURL new url: urlLink) ].
+ 	fontSpecs isEmptyOrNil
+ 		ifFalse: [attribs addAll: fontSpecs last]
+ 		ifTrue: [attribs add: (TextFontChange defaultFontChange)].
+ 	outputStream currentAttributes: attribs!

Item was added:
+ ----- Method: DHtmlFormatter>>startFont: (in category 'formatting commands') -----
+ startFont: aTextAttribList
+ 	"aTextAttribList is a collection of TextAttributes"
+ 	fontSpecs ifNil: [fontSpecs _ OrderedCollection new].
+ 	fontSpecs add: aTextAttribList.
+ 	self setAttributes!

Item was added:
+ ----- Method: DHtmlFormatter>>startHeader: (in category 'formatting commands') -----
+ startHeader: level
+ 	self ensureNewlines: 3.
+ 	boldLevel _ boldLevel + 1. "self increaseBold"
+ 	self startFont: (self headerFont: level).!

Item was changed:
  ----- Method: DataType>>addWatcherItemsToMenu:forGetter: (in category '*Etoys-tiles') -----
  addWatcherItemsToMenu: aMenu forGetter: aGetter
  	"Add watcher items to the menu if appropriate, provided the getter is not an odd-ball one for which a watcher makes no sense"
  
  	(Vocabulary gettersForbiddenFromWatchers includes: aGetter) ifFalse:
  		[aMenu add: 'simple watcher' translated selector: #tearOffUnlabeledWatcherFor: argument: aGetter.
+ 		aMenu balloonTextForLastItem: 'obtain an unlabeled readout which shows the value of this variable' translated.
+ 
  		aMenu add: 'detailed watcher' translated selector: #tearOffFancyWatcherFor: argument: aGetter.
+ 		aMenu balloonTextForLastItem: 'obtain a labeled readout which shows the object name and the name and value of this variable' translated.
+ 
+ 		aMenu add: 'attached watcher' translated selector: #tearOffAttachedWatcherFor: argument: aGetter.
+ 		aMenu balloonTextForLastItem: 'attach an unlabeled readout to the object which shows the value of this variable' translated.
+ 
+ 		aMenu add: 'attached labeled watcher' translated selector: #tearOffAttachedLabeledWatcherFor: argument: aGetter.
+ 		aMenu balloonTextForLastItem: 'make a readout showing the name and value of this variable, and attach it to the object itself' translated.
+ 
  		aMenu addLine]!

Item was changed:
  ----- Method: DataType>>updatingTileForTarget:partName:getter:setter: (in category '*Etoys-tiles') -----
  updatingTileForTarget: aTarget partName: partName getter: getter setter: setter
  	"Answer, for classic tiles, an updating readout tile for a part with the receiver's type, with the given getter and setter"
  
  	| aTile displayer actualSetter |
+ 	actualSetter _ setter ifNotNil:
- 	actualSetter := setter ifNotNil:
  		[(#(none #nil unused) includes: setter) ifTrue: [nil] ifFalse: [setter]].
  
+ 	aTile _ self newReadoutTile.
- 	aTile := self newReadoutTile.
  
+ 	displayer _ UpdatingStringMorph new
- 	displayer := UpdatingStringMorph new
  		getSelector: getter;
  		target: aTarget;
  		growable: true;
+ 		minimumWidth: 48;
- 		minimumWidth: 24;
  		putSelector: actualSetter.
+ 	"Note that where relevant (Number and Point types), the #target: call above will have dealt with floatPrecision details"
- 	"Note that when typeSymbol = #number, the #target: call above will have dealt with floatPrecision details"
  
+ 	displayer font: Preferences standardEToysFont.
  	self setFormatForDisplayer: displayer.
  	aTile addMorphBack: displayer.
+ 	displayer setNameTo: 'readout string' translated.
  	(actualSetter notNil and: [self wantsArrowsOnTiles]) ifTrue: [aTile addArrows].	
+ 	getter numArgs == 0 ifTrue:
- 	getter numArgs = 0 ifTrue:
  		[aTile setLiteralInitially: (aTarget perform: getter)].
  	^ aTile
  !

Item was added:
+ ----- Method: Date>>asJulianDayNumber (in category '*Etoys-Squeakland-deprecated') -----
+ asJulianDayNumber
+ 	"Answer the julian date number of the receiver."
+ 
+ 	^ self asDateAndTime julianDayNumber!

Item was added:
+ ----- Method: Debugger>>buttonRowForPreDebugWindow: (in category '*Etoys-Squeakland-initialize') -----
+ buttonRowForPreDebugWindow: aDebugWindow
+ 	"Answer a morph that will serve as the button row in a pre-debug window."
+ 
+ 	| aRow aButton quads aFont |
+ 	aRow _ AlignmentMorph newRow hResizing: #spaceFill.
+ 	aRow beSticky.
+ 	aRow on: #mouseDown send: #yourself to: self.  "Avoid dragging window."
+ 	aRow addMorphBack: AlignmentMorph newVariableTransparentSpacer.
+ 	quads _ OrderedCollection withAll: self preDebugButtonQuads.
+ 	((self interruptedContext selector == #doesNotUnderstand:) and:
+ 		[Preferences eToyFriendly not]) ifTrue:
+ 		[quads add: { 'Create'. #createMethod. #magenta. 'create the missing method' }].
+ 	aFont := Preferences eToyFriendly
+ 		ifFalse:
+ 			[Preferences standardButtonFont]
+ 		ifTrue:
+ 			[Preferences standardEToysButtonFont].
+ 	quads do:
+ 			[:quad |
+ 				aButton _ SimpleButtonMorph new target: aDebugWindow.
+ 				aButton color: Color transparent; borderWidth: 1.
+ 				aButton actionSelector: quad second.
+ 				aButton label: quad first font: aFont.
+ 				aButton submorphs first color: (Color colorFrom: quad third).
+ 				aButton setBalloonText: quad fourth.
+ 				Preferences alternativeWindowLook 
+ 					ifTrue:[aButton borderWidth: 2; borderColor: #raised].
+ 				aRow addMorphBack: aButton.
+ 				aRow addMorphBack: AlignmentMorph newVariableTransparentSpacer].
+ 	^ aRow!

Item was added:
+ ----- Method: Debugger>>preDebugNotifierContentsFrom: (in category '*Etoys-Squeakland-initialize') -----
+ preDebugNotifierContentsFrom: messageString
+ 	| first second msg |
+ 	^ Preferences eToyFriendly
+ 		ifFalse:
+ 			[messageString]
+ 		ifTrue:
+ 			[
+ 				msg _ messageString.
+ 				msg ifNil: [msg _ ''].
+ 				first _ second _ 0.
+ 				first _ msg indexOf: $\ ifAbsent: [0].
+ 				first > 0 ifTrue: [second _ msg indexOf: $\ startingAt: first + 1 ifAbsent: [0]].
+ 				(first > 0 and: [second > 0]) ifTrue: [
+ 					'An error has occurred in\{3} of {2}.\Fix your script(s), hit ''Abandon'' and try again.' translated withCRs format: {msg copyFrom: 1 to: first - 1. msg copyFrom: first + 1 to: second - 1. msg copyFrom: second + 1 to: msg size}
+ 				] ifFalse: [
+ 					'An error has occurred; you should probably just hit ''abandon''.  Sorry!!' translated
+ 				]
+ 			] !

Item was added:
+ ----- Method: Decompiler>>checkForBlock: (in category '*Etoys-Squeakland-control') -----
+ checkForBlock: receiver
+ 	"We just saw a blockCopy: message. Check for a following block."
+ 
+ 	| savePc jump args argPos block |
+ 	receiver == constructor codeThisContext ifFalse: [^false].
+ 	savePc _ pc.
+ 	(jump _ self interpretJump) notNil
+ 		ifFalse:
+ 			[pc _ savePc.  ^nil].
+ 	"Definitely a block"
+ 	jump _ jump + pc.
+ 	argPos _ statements size.
+ 	[self willStorePop]
+ 		whileTrue:
+ 			[stack addLast: ArgumentFlag.  "Flag for doStore:"
+ 			self interpretNextInstructionFor: self].
+ 	args _ Array new: statements size - argPos.
+ 	1 to: args size do:  "Retrieve args"
+ 		[:i | args at: i put: statements removeLast.
+ 		(args at: i) scope: -1  "flag args as block temps"].
+ 	block _ self blockTo: jump.
+ 	stack addLast: (constructor codeArguments: args block: block).
+ 	^true!

Item was added:
+ ----- Method: DeepCopier>>checkNewTarget (in category '*Etoys-Squeakland-checking') -----
+ checkNewTarget
+ 	"Any class that holds a morph in an instance variable needs to hold is weakly.  The morph should only be copied it is really is in the tree of morphs of this deepCopy.  Search for classes that have target and xxxSelector and xxxArguments, and do not implement veryDeepInner: and veryDeepFixupWith:.  Show them in the transcript.
+ 	DeepCopier new checkNewTarget	 "
+ 
+ 	| suspect |
+ 	suspect _ 'selector'.
+ 	(self systemNavigation allClasses) do: [:aClass | 
+ 		aClass instVarNames do: [:instN |
+ 			('*',suspect,'*' match: instN) ifTrue: [
+ 				aClass compiledMethodAt: #veryDeepInner: ifAbsent: [
+ 					Transcript show: aClass name, ' ', instN; cr]]]].
+ 
+ 
+ "		Look in selectors...  (too many of these)
+ 	suspect _ 'selector'.
+ 	(self systemNavigation allClasses) do: [:aClass | 
+ 		aClass methodDictionary keysDo: [:key |
+ 			('*',suspect,'*' match: key) ifTrue: [
+ 				aClass compiledMethodAt: #veryDeepInner: ifAbsent: [
+ 					Transcript show: aClass name, ' ', key; cr]]]].
+ "!

Item was added:
+ ----- Method: DeepCopier>>mapUniClassMethods: (in category '*Etoys-Squeakland-full copy') -----
+ mapUniClassMethods: pool
+ 	"Players also refer to each other using associations in the References dictionary.  Search the literals of the methods of our Players for those.  There are already new entries in project-local References and point to them."
+ | newKey newAssoc oldSelList newSelList newValue |
+ 
+ uniClasses "values" do: [:newClass |
+ 	oldSelList _ OrderedCollection new.   newSelList _ OrderedCollection new.
+ 	newClass selectorsDo: [:sel | 
+ 		(newClass compiledMethodAt: sel)	 literals do: [:assoc |
+ 			assoc isVariableBinding ifTrue: [
+ 				newValue _ references at: assoc value ifAbsent: [].
+ 				newValue ifNotNil: [
+ 					newKey _ newValue externalName asSymbol.
+ 					(assoc key ~= newKey) & (pool includesKey: newKey) ifTrue: [
+ 						newAssoc _ pool associationAt: newKey.
+ 						newClass methodDictionary at: sel put: 
+ 							(newClass compiledMethodAt: sel) clone.	"were sharing it"
+ 						(newClass compiledMethodAt: sel)
+ 							literalAt: ((newClass compiledMethodAt: sel) literals indexOf: assoc)
+ 							put: newAssoc.
+ 						(oldSelList includes: assoc key) ifFalse: [
+ 							oldSelList add: assoc key.  newSelList add: newKey]]]]]].
+ 	oldSelList with: newSelList do: [:old :new |
+ 			newClass replaceSilently: old to: new]].	"This is text replacement and can be wrong"!

Item was added:
+ StandardSystemController subclass: #DeferredActionStandardSystemController
+ 	instanceVariableNames: 'queue'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tools-Process Browser'!
+ 
+ !DeferredActionStandardSystemController commentStamp: '<historical>' prior: 0!
+ This is a StandardSystemController that can queue up objects to be evaluated before its control loop.!

Item was added:
+ ----- Method: DeferredActionStandardSystemController>>addDeferredUIMessage: (in category 'as yet unclassified') -----
+ addDeferredUIMessage: valuableObject 
+ 	queue nextPut: valuableObject!

Item was added:
+ ----- Method: DeferredActionStandardSystemController>>controlActivity (in category 'as yet unclassified') -----
+ controlActivity
+ 	[queue isEmpty]
+ 		whileFalse: [queue next value].
+ 	^super controlActivity!

Item was added:
+ ----- Method: DeferredActionStandardSystemController>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 	super initialize.
+ 	queue _ SharedQueue new.!

Item was added:
+ ----- Method: Delay class>>scheduleDelay: (in category '*Etoys-Squeakland-timer process') -----
+ scheduleDelay: aDelay
+ 	"Private. Schedule this Delay."
+ 	aDelay beingWaitedOn: true.
+ 	ActiveDelay ifNil:[
+ 		ActiveDelay := aDelay
+ 	] ifNotNil:[
+ 		aDelay resumptionTime < ActiveDelay resumptionTime ifTrue:[
+ 			SuspendedDelays add: ActiveDelay.
+ 			ActiveDelay := aDelay.
+ 		] ifFalse: [SuspendedDelays add: aDelay].
+ 	].
+ !

Item was added:
+ ----- Method: Delay class>>startTimerInterruptWatcher (in category '*Etoys-Squeakland-timer process') -----
+ startTimerInterruptWatcher
+ 	"Reset the class variables that keep track of active Delays and re-start the timer interrupt watcher process. Any currently scheduled delays are forgotten."
+ 	"Delay startTimerInterruptWatcher"
+ 	| p |
+ 	self stopTimerEventLoop.
+ 	self stopTimerInterruptWatcher.
+ 	TimingSemaphore := Semaphore new.
+ 	AccessProtect := Semaphore forMutualExclusion.
+ 	SuspendedDelays := 
+ 		SortedCollection sortBlock: 
+ 			[:d1 :d2 | d1 resumptionTime <= d2 resumptionTime].
+ 	ActiveDelay := nil.
+ 	p := [self timerInterruptWatcher] newProcess.
+ 	p priority: Processor timingPriority.
+ 	p resume.
+ !

Item was added:
+ ----- Method: Delay class>>stopTimerInterruptWatcher (in category '*Etoys-Squeakland-timer process') -----
+ stopTimerInterruptWatcher
+ 	"Reset the class variables that keep track of active Delays and re-start the timer interrupt watcher process. Any currently scheduled delays are forgotten."
+ 	"Delay startTimerInterruptWatcher"
+ 	self primSignal: nil atMilliseconds: 0.
+ 	TimingSemaphore ifNotNil:[TimingSemaphore terminateProcess].!

Item was added:
+ ----- Method: Delay>>activate (in category '*Etoys-Squeakland-private') -----
+ activate
+ 	"Private!! Make the receiver the Delay to be awoken when the next timer interrupt occurs. This method should only be called from a block protected by the AccessProtect semaphore."
+ 	TimerEventLoop ifNotNil:[^nil].
+ 	ActiveDelay := self.
+ 	ActiveDelayStartTime := Time millisecondClockValue.
+ 	ActiveDelayStartTime > resumptionTime ifTrue:[
+ 		ActiveDelay signalWaitingProcess.
+ 		SuspendedDelays isEmpty ifTrue:[
+ 			ActiveDelay := nil.
+ 			ActiveDelayStartTime := nil.
+ 		] ifFalse:[SuspendedDelays removeFirst activate].
+ 	] ifFalse:[
+ 		TimingSemaphore initSignals.
+ 		Delay primSignal: TimingSemaphore atMilliseconds: resumptionTime.
+ 	].!

Item was added:
+ ----- Method: Delay>>scheduleEvent (in category '*Etoys-Squeakland-private') -----
+ scheduleEvent
+ 	"Schedule this delay"
+ 	resumptionTime := Time millisecondClockValue + delayDuration.
+ 	AccessProtect critical:[
+ 		ScheduledDelay := self.
+ 		TimingSemaphore signal.
+ 	].!

Item was added:
+ MethodNode subclass: #DialectMethodNode
+ 	instanceVariableNames: 'dialect'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Compiler'!
+ 
+ !DialectMethodNode commentStamp: '<historical>' prior: 0!
+ The purpose of this class is to carry along with theinformation in a regular method node the further information that it was parsed from an laternate dialect of Squeak.  Which dialect that was is carried as a symbol in the dialect variable.!

Item was added:
+ ----- Method: DialectMethodNode>>setDialect: (in category 'as yet unclassified') -----
+ setDialect: dialectSymbol
+ 
+ 	dialect _ dialectSymbol!

Item was added:
+ ----- Method: DialectMethodNode>>test:with: (in category 'as yet unclassified') -----
+ test: arg1 with: arg2 
+ 	^ 3 between: arg1 and: arg2!

Item was added:
+ Parser subclass: #DialectParser
+ 	instanceVariableNames: 'dialect'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Compiler'!
+ 
+ !DialectParser commentStamp: '<historical>' prior: 0!
+ This Parser is part of a package designed to allow for experiments with alternatives to ST-80 syntax.  The particular alternative offered by this parser eliminates colons, left-arrows and up-arrows, and adds prefix keywords for common control constructs.
+ 
+ ST-80									SQ-00
+ -------									-------
+ a + b between: c and: c + 4				a + b between (c) and (c + 4)
+ a _ 3.0									Set a to 3.0
+ ^ self size + 3							Return self size + 3
+ a > b									Test (a > b)
+ 	ifTrue: ['greater']						ifTrue ['greater']
+ 	ifFalse: ['less']							ifFalse ['less']
+ 1 to: 9 do:								Repeat (1) to (9) do
+ 	[:i | Transcript cr; show: i]				[Set i. | Transcript cr; show (i)]
+ 
+ The use of prefix keywords is currently ad-hoc;  in other words they are built into the parser, and there is not a way to define a method pattern to include a prefix keyword.  Most of the work has been done to support this, though, as selectors can now have the form
+ 	#:prefix:kwd1:kwd2:
+ and they will respond appropriately to #keywords and #numArgs.
+ 
+ A test method in the class ensures that every method in the system can be pretty-printed in the alternative syntax, and that compiling the resulting text produces exactly the same bytecodes as the original method.!

Item was added:
+ ----- Method: DialectParser class>>test (in category 'as yet unclassified') -----
+ test    "DialectParser test"
+ 
+ "PrettyPrints the source for every method in the system in the alternative syntax, and then compiles that source and verifies that it generates identical code.  No changes are actually made to the system.  At the time of this writing, only two methods caused complaints (reported in Transcript and displayed in browse window after running):
+ 
+ 	BalloonEngineSimulation circleCosTable and
+ 	BalloonEngineSimulation circleSinTable.
+ 
+ These are not errors, but merely a case of Floats embedded in literal arrays, and thus not specially checked for roundoff errors.
+ 
+ Note that if an error or interruption occurs during execution of this method, the alternativeSyntax preference will be left on.
+ 
+ NOTE:  Some methods may not compare properly until the system has been recompiled once.  Do this by executing...
+ 		Smalltalk recompileAllFrom: 'AARDVAARK'.
+ "
+ 
+ 	 | newCodeString methodNode oldMethod newMethod badOnes n heading |
+ 	Preferences enable: #printAlternateSyntax.
+ 	badOnes _ OrderedCollection new.
+ 	Transcript clear.
+ 	Smalltalk forgetDoIts.
+ 'Formatting and recompiling all classes...'
+ displayProgressAt: Sensor cursorPoint
+ from: 0 to: CompiledMethod instanceCount
+ during: [:bar | n _ 0.
+ 	Smalltalk allClassesDo:  "{MethodNode} do:"  "<- to check one class"
+ 		[:nonMeta |  "Transcript cr; show: nonMeta name."
+ 		{nonMeta. nonMeta class} do:
+ 		[:cls |
+ 		cls selectors do:
+ 			[:selector | (n _ n+1) \\ 100 = 0 ifTrue: [bar value: n].
+ 			newCodeString _ (cls compilerClass new)
+ 				format: (cls sourceCodeAt: selector)
+ 				in: cls notifying: nil decorated: Preferences colorWhenPrettyPrinting.
+ 			heading _ cls organization categoryOfElement: selector.
+ 			methodNode _ cls compilerClass new
+ 						compile: newCodeString
+ 						in: cls notifying: (SyntaxError new category: heading)
+ 						ifFail: [].
+ 			newMethod _ methodNode generate: CompiledMethodTrailer empty.
+ 			oldMethod _ cls compiledMethodAt: selector.
+ 			"Transcript cr; show: cls name , ' ' , selector."
+ 			oldMethod = newMethod ifFalse:
+ 				[Transcript cr; show: '***' , cls name , ' ' , selector.
+ 				oldMethod size = newMethod size ifFalse:
+ 					[Transcript show: ' difft size'].
+ 				oldMethod header = newMethod header ifFalse:
+ 					[Transcript show: ' difft header'].
+ 				oldMethod literals = newMethod literals ifFalse:
+ 					[Transcript show: ' difft literals'].
+ 				Transcript endEntry.
+ 				badOnes add: cls name , ' ' , selector]]]].
+ ].
+ 	self systemNavigation browseMessageList: badOnes asSortedCollection name: 'Formatter Discrepancies'.
+ 	Preferences disable: #printAlternateSyntax.
+ !

Item was added:
+ ----- Method: DialectParser>>assignment: (in category 'as yet unclassified') -----
+ assignment: varNode
+ 	" 'set' (var) 'to' (expression) => AssignmentNode."
+ 	| loc |
+ 	(loc _ varNode assignmentCheck: encoder at: prevMark + requestorOffset) >= 0
+ 		ifTrue: [^self notify: 'Cannot store into' at: loc].
+ 	varNode nowHasDef.
+ 	self advance.  " to "
+ 	self expression ifFalse: [^self expected: 'Expression'].
+ 	parseNode _ AssignmentNode new
+ 				variable: varNode
+ 				value: parseNode
+ 				from: encoder.
+ 	^ true!

Item was added:
+ ----- Method: DialectParser>>blockExpression (in category 'as yet unclassified') -----
+ blockExpression
+ 	"[ ({:var} |) (| {temps} |) (statements) ] => BlockNode."
+ 
+ 	| variableNodes temporaryBlockVariables |
+ 	variableNodes _ OrderedCollection new.
+ 
+ 	"Gather parameters."
+ 	(self matchToken: 'With') ifTrue:
+ 		[[self match: #period]
+ 			whileFalse: [variableNodes addLast: (encoder autoBind: self argumentName)]].
+ 
+ 	temporaryBlockVariables _ self temporaryBlockVariables.
+ 	self statements: variableNodes innerBlock: true.
+ 	parseNode temporaries: temporaryBlockVariables.
+ 
+ 	(self match: #rightBracket) ifFalse: [^ self expected: 'Period or right bracket'].
+ 
+ 	"The scope of the parameters and temporary block variables is no longer active."
+ 	temporaryBlockVariables do: [:variable | variable scope: -1].
+ 	variableNodes do: [:variable | variable scope: -1]!

Item was added:
+ ----- Method: DialectParser>>expression (in category 'as yet unclassified') -----
+ expression
+ 
+ 	^ self expressionWithInitialKeyword: ''
+ !

Item was added:
+ ----- Method: DialectParser>>expressionWithInitialKeyword: (in category 'as yet unclassified') -----
+ expressionWithInitialKeyword: kwdIfAny
+ 
+ 	| checkpoint |
+ 	(hereType == #word and: [here = 'Set' and: [tokenType == #word]]) ifTrue:
+ 			["Parse assignment statement 'Set' var 'to' expression"
+ 			checkpoint _ self checkpoint.
+ 			self advance.
+ 			token = 'to'
+ 				ifTrue: [^ self assignment: self variable]
+ 				ifFalse: [self revertToCheckpoint: checkpoint]].
+ 	self matchKeyword
+ 		ifTrue: ["It's an initial keyword."
+ 				kwdIfAny isEmpty ifFalse: [self error: 'compiler logic error'].
+ 				^ self expressionWithInitialKeyword: ':' , self advance , ':'].
+ 	hereType == #leftBrace
+ 		ifTrue: [self braceExpression]
+ 		ifFalse: [self primaryExpression ifFalse: [^ false]].
+ 	(self messagePart: 3 repeat: true initialKeyword: kwdIfAny)
+ 		ifTrue: [hereType == #semicolon ifTrue: [self cascade]].
+ 	^ true!

Item was added:
+ ----- Method: DialectParser>>matchKeyword (in category 'as yet unclassified') -----
+ matchKeyword
+ 	"Return true if we are looking at a keyword (and its argument)."
+ 
+ 	hereType == #word ifFalse: [^ false].
+ 	tokenType == #leftParenthesis ifTrue: [^ true].
+ 	tokenType == #leftBracket ifTrue: [^ true].
+ 	tokenType == #leftBrace ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: DialectParser>>matchReturn (in category 'as yet unclassified') -----
+ matchReturn
+ 
+ 	^ self matchToken: 'Answer'!

Item was added:
+ ----- Method: DialectParser>>messagePart:repeat: (in category 'as yet unclassified') -----
+ messagePart: level repeat: repeat
+ 
+ 	^ self messagePart: level repeat: repeat initialKeyword: ''!

Item was added:
+ ----- Method: DialectParser>>messagePart:repeat:initialKeyword: (in category 'as yet unclassified') -----
+ messagePart: level repeat: repeat initialKeyword: kwdIfAny
+ 
+ 	| start receiver selector args precedence words keywordStart |
+ 	[receiver _ parseNode.
+ 	(self matchKeyword and: [level >= 3])
+ 		ifTrue: 
+ 			[start _ self startOfNextToken.
+ 			selector _ WriteStream on: (String new: 32).
+ 			selector nextPutAll: kwdIfAny.
+ 			args _ OrderedCollection new.
+ 			words _ OrderedCollection new.
+ 			[self matchKeyword]
+ 				whileTrue: 
+ 					[keywordStart _ self startOfNextToken + requestorOffset.
+ 					selector nextPutAll: self advance , ':'.
+ 					words addLast: (keywordStart to: hereEnd + requestorOffset).
+ 					self primaryExpression ifFalse: [^ self expected: 'Argument'].
+ 					args addLast: parseNode].
+ 			(Symbol hasInterned: selector contents ifTrue: [ :sym | selector _ sym])
+ 				ifFalse: [ selector _ self correctSelector: selector contents
+ 										wordIntervals: words
+ 										exprInterval: (start to: self endOfLastToken)
+ 										ifAbort: [ ^ self fail ] ].
+ 			precedence _ 3]
+ 		ifFalse: [((hereType == #binary or: [hereType == #verticalBar])
+ 				and: [level >= 2])
+ 				ifTrue: 
+ 					[start _ self startOfNextToken.
+ 					selector _ self advance asSymbol.
+ 					self primaryExpression ifFalse: [^self expected: 'Argument'].
+ 					self messagePart: 1 repeat: true.
+ 					args _ Array with: parseNode.
+ 					precedence _ 2]
+ 				ifFalse: [(hereType == #word
+ 							and: [(#(leftParenthesis leftBracket leftBrace) includes: tokenType) not])
+ 						ifTrue: 
+ 							[start _ self startOfNextToken.
+ 							selector _ self advance.
+ 							args _ #().
+ 							words _ OrderedCollection with: (start  + requestorOffset to: self endOfLastToken + requestorOffset).
+ 							(Symbol hasInterned: selector ifTrue: [ :sym | selector _ sym])
+ 								ifFalse: [ selector _ self correctSelector: selector
+ 													wordIntervals: words
+ 													exprInterval: (start to: self endOfLastToken)
+ 													ifAbort: [ ^ self fail ] ].
+ 							precedence _ 1]
+ 						ifFalse: [^args notNil]]].
+ 	parseNode _ MessageNode new
+ 				receiver: receiver
+ 				selector: selector
+ 				arguments: args
+ 				precedence: precedence
+ 				from: encoder
+ 				sourceRange: (start to: self endOfLastToken).
+ 	repeat]
+ 		whileTrue: [].
+ 	^true!

Item was added:
+ ----- Method: DialectParser>>newMethodNode (in category 'as yet unclassified') -----
+ newMethodNode
+ 
+ 	^ DialectMethodNode new setDialect: #SQ00!

Item was added:
+ ----- Method: DialectParser>>parseArgsAndTemps:notifying: (in category 'as yet unclassified') -----
+ parseArgsAndTemps: aString notifying: req 
+ 	"Parse the argument, aString, notifying req if an error occurs. Otherwise, 
+ 	answer a two-element Array containing Arrays of strings (the argument 
+ 	names and temporary variable names)."
+ 
+ 	aString == nil ifTrue: [^#()].
+ 	doitFlag _ false.		"Don't really know if a doit or not!!"
+ 	^self initPattern: aString
+ 		notifying: req
+ 		return: [:pattern | (pattern at: 2) , self temporaries]!

Item was added:
+ ----- Method: DialectParser>>pattern:inContext: (in category 'as yet unclassified') -----
+ pattern: fromDoit inContext: ctxt 
+ 	" unarySelector | binarySelector arg | keyword arg {keyword arg} =>  
+ 	{selector, arguments, precedence}."
+ 	| args selector checkpoint |
+ 	doitFlag _ fromDoit.
+ 	fromDoit ifTrue:
+ 			[ctxt == nil
+ 				ifTrue: [^ {#DoIt. {}. 1}]
+ 				ifFalse: [^ {#DoItIn:. {encoder encodeVariable: 'homeContext'}. 3}]].
+ 
+ 	"NOTE: there is now an ambiguity between
+ 	keywordSelector (argName) -and- unarySelector (first expression).
+ 	Also, there is an amibuity (if there are no temp declarations) between
+ 	keywordSelector (argName) -and- PrefixKeyword (some expression).
+ 	We use duct tape for now."
+ 	(hereType == #word and: [tokenType == #leftParenthesis]) ifTrue:
+ 		[checkpoint _ self checkpoint.  "in case we have to back out"
+ 		selector _ WriteStream on: (String new: 32).
+ 			args _ OrderedCollection new.
+ 			[hereType == #word
+ 				and: [tokenType == #leftParenthesis
+ 				and: [here first isLowercase
+ 						or: [(#('Test' 'Repeat' 'Answer') includes: here) not]]]]
+ 				whileTrue: 
+ 					[selector nextPutAll: self advance , ':'.  "selector part"
+ 					self advance.  "open paren"
+ 					(args size = 0 and: [tokenType ~~ #rightParenthesis]) ifTrue:
+ 						["This is really a unary selector on a method that
+ 						begins with a parenthesized expression.  Back out now"
+ 						self revertToCheckpoint: checkpoint.
+ 						^ {self advance asSymbol. {}. 1}].
+ 					args addLast: (encoder bindArg: self argumentName).
+ 			(self match: #rightParenthesis)
+ 						ifFalse: [^ self expected: 'right parenthesis']].
+ 			^ {selector contents asSymbol. args. 3}].
+ 
+ 	hereType == #word ifTrue: [^ {self advance asSymbol. {}. 1}].
+ 
+ 	(hereType == #binary or: [hereType == #verticalBar])
+ 		ifTrue: 
+ 			[selector _ self advance asSymbol.
+ 			args _ Array with: (encoder bindArg: self argumentName).
+ 			^ {selector. args. 2}].
+ 
+ 	^ self expected: 'Message pattern'!

Item was added:
+ ----- Method: DialectParser>>temporaries (in category 'as yet unclassified') -----
+ temporaries
+ 	" [ 'Use' (variable)* '.' ]"
+ 	| vars theActualText |
+ 	(self matchToken: #'Use') ifFalse: 
+ 		["no temps"
+ 		doitFlag ifTrue: [requestor
+ 				ifNil: [tempsMark _ 1]
+ 				ifNotNil: [tempsMark _ requestor selectionInterval first].
+ 			^ #()].
+ 		tempsMark _ prevEnd+1.
+ 		tempsMark > 0 ifTrue:
+ 			[theActualText _ source contents.
+ 			[tempsMark < theActualText size and: [(theActualText at: tempsMark) isSeparator]]
+ 				whileTrue: [tempsMark _ tempsMark + 1]].
+ 			^ #()].
+ 	vars _ OrderedCollection new.
+ 	[hereType == #word]
+ 		whileTrue: [vars addLast: (encoder bindTemp: self advance)].
+ 	(self match: #period) ifTrue: 
+ 		[tempsMark _ prevMark.
+ 		^ vars].
+ 	^ self expected: 'Period'!

Item was added:
+ TextStream subclass: #DialectStream
+ 	instanceVariableNames: 'dialect colorTable'
+ 	classVariableNames: 'Sq00ColorTable ST80ColorTable'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Compiler'!

Item was added:
+ ----- Method: DialectStream class>>dialect:contents: (in category 'instance creation') -----
+ dialect: dialectSymbol contents: blockWithArg 
+ 	"Evaluate blockWithArg on a DialectStream of the given description"
+ 
+ 	| stream |
+ 	stream _ self on: (Text new: 400).
+ 	stream setDialect: dialectSymbol.
+ 	blockWithArg value: stream.
+ 	^ stream contents!

Item was added:
+ ----- Method: DialectStream class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"Initialize the color tables"
+ 
+ 	self initializeST80ColorTable.
+ 	self initializeSq00ColorTable.
+ 
+ "DialectStream initialize"
+ !

Item was added:
+ ----- Method: DialectStream class>>initializeST80ColorTable (in category 'class initialization') -----
+ initializeST80ColorTable
+ 	"Initiialize the colors that characterize the ST80 dialect"
+ 
+ 	ST80ColorTable _ IdentityDictionary new.
+ 	#(	(temporaryVariable blue italic)
+ 		(methodArgument blue normal)
+ 		(methodSelector black bold)
+ 		(blockArgument red normal)
+ 		(comment brown normal)
+ 		(variable magenta normal)
+ 		(literal	tan normal)
+ 		(keyword darkGray bold)
+ 		(prefixKeyword veryDarkGray bold)
+ 		(setOrReturn black bold)) do:
+ 			[:aTriplet |
+ 				ST80ColorTable at: aTriplet first put: aTriplet allButFirst]
+ 
+ "DialectStream initialize"!

Item was added:
+ ----- Method: DialectStream class>>initializeSq00ColorTable (in category 'class initialization') -----
+ initializeSq00ColorTable
+ 	"Initiialize the colors that characterize the Sq00 dialect"
+ 
+ 	Sq00ColorTable _ IdentityDictionary new.
+ 	#(	(temporaryVariable black normal)
+ 		(methodArgument black normal)
+ 		(methodSelector black bold)
+ 		(blockArgument black normal)
+ 		(comment brown normal)
+ 		(variable black normal)
+ 		(literal	 blue normal)
+ 		(keyword darkGray bold)
+ 		(prefixKeyword veryDarkGray bold)
+ 		(setOrReturn black bold)) do:
+ 			[:aTriplet |
+ 				Sq00ColorTable at: aTriplet first put: aTriplet allButFirst]!

Item was added:
+ ----- Method: DialectStream>>colorTable (in category 'color/style') -----
+ colorTable
+ 	"Answer the table to use to determine colors"
+ 
+ 	^ colorTable ifNil:
+ 		[colorTable _ dialect == #SQ00
+ 			ifTrue:
+ 				[Sq00ColorTable]
+ 			ifFalse:
+ 				[ST80ColorTable]]!

Item was added:
+ ----- Method: DialectStream>>dialect (in category 'access') -----
+ dialect
+ 
+ 	^ dialect!

Item was added:
+ ----- Method: DialectStream>>setDialect: (in category 'access') -----
+ setDialect: dialectSymbol
+ 
+ 	dialect _ dialectSymbol!

Item was added:
+ ----- Method: DialectStream>>withColor:emphasis:do: (in category 'color/style') -----
+ withColor: colorSymbol emphasis: emphasisSymbol do: aBlock
+ 	"Evaluate the given block with the given color and style text attribute"
+ 
+ 	^ self withAttributes: {TextColor color: (Color perform: colorSymbol).
+ 							TextEmphasis perform: emphasisSymbol}
+ 		do: aBlock!

Item was added:
+ ----- Method: DialectStream>>withStyleFor:do: (in category 'color/style') -----
+ withStyleFor: elementType do: aBlock
+ 	"Evaluate aBlock with appropriate emphasis and color for the given elementType"
+ 
+ 	| colorAndStyle |
+ 	colorAndStyle _ self colorTable at: elementType.
+ 	^ self withColor: colorAndStyle first emphasis: colorAndStyle second do: aBlock!

Item was added:
+ ----- Method: Dictionary>>customizeExplorerContents (in category '*Etoys-Squeakland-accessing') -----
+ customizeExplorerContents
+ 
+ 	^ true.
+ !

Item was added:
+ ----- Method: Dictionary>>errorKeyNotFound (in category '*Etoys-Squeakland-private') -----
+ errorKeyNotFound
+ 
+ 	self error: 'key not found'!

Item was added:
+ ----- Method: Dictionary>>explorerContentsWithIndexCollect: (in category '*Etoys-Squeakland-user interface') -----
+ explorerContentsWithIndexCollect: twoArgBlock
+ 
+ 	| sortedKeys |
+ 	sortedKeys _ self keys asSortedCollection: [:x :y |
+ 		((x isString and: [y isString])
+ 			or: [x isNumber and: [y isNumber]])
+ 			ifTrue: [x < y]
+ 			ifFalse: [x class == y class
+ 				ifTrue: [x printString < y printString]
+ 				ifFalse: [x class name < y class name]]].
+ 	^ sortedKeys collect: [:k | twoArgBlock value: (self at: k) value: k].
+ !

Item was added:
+ ----- Method: Dictionary>>keyAt: (in category '*Etoys-Squeakland-private') -----
+ keyAt: index
+ 	"May be overridden by subclasses so that fixCollisions will work"
+ 	| assn |
+ 	assn _ array at: index.
+ 	assn == nil ifTrue: [^ nil]
+ 				ifFalse: [^ assn key]!

Item was added:
+ ----- Method: Dictionary>>noCheckAdd: (in category '*Etoys-Squeakland-private') -----
+ noCheckAdd: anObject
+ 	"Must be defined separately for Dictionary because (self findElementOrNil:) expects a key, not an association.  9/7/96 tk"
+ 
+ 	array at: (self findElementOrNil: anObject key) put: anObject.
+ 	tally _ tally + 1!

Item was added:
+ ----- Method: DisplayScreen class>>hostWindowSize: (in category '*Etoys-Squeakland-host window access') -----
+ hostWindowSize: aPoint 
+ 	self primitiveWindowSize: self hostWindowIndex width: aPoint x heigth: aPoint y
+ !

Item was added:
+ ----- Method: DisplayScreen class>>lastScreenModeSelected (in category '*Etoys-Squeakland-screen modes') -----
+ lastScreenModeSelected
+ 
+ 	^LastScreenModeSelected!

Item was added:
+ ----- Method: DisplayScreen class>>primitiveWindowSize:width:heigth: (in category '*Etoys-Squeakland-host window access') -----
+ primitiveWindowSize: id width: width heigth: height 
+ 	<primitive: 'primitiveHostWindowSizeSet' module: 'HostWindowPlugin'>
+ 	"ignore failure"!

Item was added:
+ ----- Method: DisplayScreen class>>primitiveWindowTitle:string: (in category '*Etoys-Squeakland-host window access') -----
+ primitiveWindowTitle: id string: titleString 
+ 	<primitive: 'primitiveHostWindowTitle' module:'HostWindowPlugin'>
+ 	"ignore failure"!

Item was added:
+ ----- Method: DisplayScreen class>>restoreDisplay (in category '*Etoys-Squeakland-screen modes') -----
+ restoreDisplay 
+ 	"Clear the screen to gray and then redisplay all the scheduled views."
+ 
+ 	Smalltalk isMorphic ifTrue: [^ World restoreMorphicDisplay].
+ 
+ 	Display extent = DisplayScreen actualScreenSize
+ 		ifFalse:
+ 			[DisplayScreen startUp.
+ 			ScheduledControllers unCacheWindows].
+ 	ScheduledControllers restore!

Item was added:
+ ----- Method: DisplayScreen>>actualDisplay (in category '*Etoys-Squeakland-private') -----
+ actualDisplay
+ 	"The display known to the VM"
+ 	^self!

Item was added:
+ ----- Method: DoCommandOnceMorph>>deleteAfterExecution: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ deleteAfterExecution: aBoolean
+ 
+ 	deleteAfterExecution _ aBoolean.
+ !

Item was added:
+ Object subclass: #DocLibrary
+ 	instanceVariableNames: 'group lastUpdate lastUpdateName methodVersions'
+ 	classVariableNames: 'DocsCachePath DropBox External'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tools-Changes'!
+ 
+ !DocLibrary commentStamp: '<historical>' prior: 0!
+ Method and Class shared documentation.  Pane in browser.  url for each official version of each method. Each update server group have a prefix (i=internal, e=external).  Point.x;.738.sp  Pane holds a pasteupmorph with comments and examples.  
+ 	Must be very careful to give the right options for when to look for docs.  Could be annoying.  Look on disk.  If there, bring it in in background.  If not there, and network has been active this session, or within 15 mins, get from server (in background) and cache on disk.  
+ 	When get updates, check for latest version of all comments in the cache.  
+ 	Need quick registration of version of inst vars (less bulky and quick to check.)  If all inst var lists are the same as a certain release, mark it as that.  Each release (or update?) have an automatic known registration.
+ 	Get doc, Get all docs for this class. //  Net: When you ask, If net has been used, Always (always gets in background) // From disk:  When you ask, always (laptop users do the former).
+   	Security: Squeakers can write anything, including players.  Users can only add Morphic objects, not players.  (No new code)
+ 	Mech:  Users write file to a server with open drop box.  Our server in Alan's office (the librarian) grabs the files once every two minutes, and scans them.  Code must be same as before.  Saves a copy.  Writes on official directory on two outside servers.
+ 	Any combo of objects of existing classes that can crash the system, or deny service?  Should the librarian try all buttons first?  If it crashes, won't post it.
+ 	Need another machine to check if the librarian is up, and beep Ted.  Could check a time stamp on the main server.  Users could also tell if librarian is up.  Number of docs in the queue.
+ 	If we had mime really down, could have squeak email the page to the librarian.  What if the user does not know his pop server?  Use a standard one?  How keep spam out?
+ -----
+ [ ] set up folders, get reader going (no good interface yet)
+ group		Name of group of servers (internal/external)
+ lastUpdate	Number of last update we have.
+ lastUpdateName		File name without number for checking against ChangeSets.
+ methodVersions	Dictionary (class.method -> #(45 secs 120 secs 198 secs)) updates 
+ 	that this method  appeared in.  From my version, check backwards till find a doc file on server.  secs is (Time totalSeconds) of file on the server (by its directory) of last version I have.  so can tell if have most recent one.  (use one day slop for older ones)
+ 	point.x;.205.sp
+ 	rectangle.205.sp
+ Names of this form that are too long are run through a dictionary and given a serial number.  It is (first two letters of class name), (crc16 of first half), (crc16 of second half).205.sp.  
+ 	Can't store over a file in the drop box, so append random number to end of name.  Look at times to figure out which one is most recent when empty drop box.
+ 			
+ localCachePath 	name of cache directory on local disk.  (Is shared between Squeaks on this machine, so might have things too new.)  In the form of a url 'file://disk/folder/'
+ 
+ Algorithm for finding the doc file:  
+ 	Find my version
+ 	Find version of current def of method relative to me.
+ 	make file name.
+ 	look locally
+ 	check server, might have changed.
+ 
+ When put new update, no extra work needed.
+ When put a new version of the system, include External with methodVersions filled in.  If methods changed and not in a numbered update, must run a method to put them in the database.
+ 
+ When get updates, add new entries as we read updates.
+ 
+ Default method update number is 0.
+ 
+ AA _ DocLibrary new initialize.
+ AA scanFolder: 'file://Ted''s/Updates 328-/' from: 595.
+ DocLibrary classPool at: #External put: AA.
+ 
+ DocLibrary new setUp.
+ 
+ [How use internal updates, but do documentation for external?  Disable feature of adding to table when get updates.  Point to UIUC external directory and scan the latest ext updates.]
+ 	When a docPane comes in, store property: #classAndMethod.  To put out, menu item "Broadcast Documentation" in PasteUpMorph that has the property.  DocLibrary puts out this morph.  Writes to drop box and local cache.
+ 	In codePane, on more menu, "Fetch Documentation" (if none, ask if want blank one).  Creates a new pasteUpMorph after verifying that it doesn't have one.
+ 	Later need preference and do fetch always and in the background.
+ 
+ 	Crude review process -- a method here that brings up each pane that is in drop box (10 at a time).  First just shows code and text, not bring in.  Then bring in.  And a way for me to store it in the official directory.  (Do as menu items in file list?)  And archives and deletes for drop box.  (I do manually twice a day?)
+ 
+ 	When write a file, take lastUpdateName and look for it in ChangeSet names.  When find, see if this method occurs in any newer changeSet.  If so, writing to an older version.  "The documentation will be attached to the version of this method in xxx.cs.  You have a newer version of that method in yyy.cs.  If what you are storing applies only to the newer version, please do not broadcast it!!  Wait until the new version is in an external update." Broadcast to all Squeak users \ Cancel.  (Otherwise "Make this documentation available to all Squeak users?")
+ 
+ When fetch any updates, look for "latest.ix"  Has format:
+ External   407   'aChangeSet.cs'
+ 376.ix
+ 'class method:' updateNumber
+ 'class method' updateNumber
+ 'class' updateNumber
+ 	Keep local copy of updates.list and read it for files not mentioned yet in latest.ix.
+ 
+ ·Warn the user if the method he is documenting is too new to be on the External updates server.
+ ·Correcting the database of method versions when new External Updates are released.
+ ·Create the file to put on the server with the database info for a new update.
+ ·Methods to help the reviewer (me) scan files.  It will show me all the code, all the doits in text, and all the text.
+ ·Allow documentation for classes, as opposed to methods. (written in file, in dict, just need interface)
+ 
+ self scanUpdatesIn: (ServerDirectory serverNamed: 'UpdatesExtUIUC') realUrl, '/'.
+ 
+ self updateMethodVersions.
+ 
+ [ ] When write, write to cache also.
+ [ ] If can't write to server, tell user to store again later.
+ [ ] Sparse database to tell if method has a docPane -- user fetches it explicitly.
+ [ ] Write to both servers.  Retrieve from either.  Drop box on just UIUC.
+ !

Item was added:
+ ----- Method: DocLibrary class>>external (in category 'as yet unclassified') -----
+ external
+ 	"The dictionary for the External Updates"
+ 	^ External!

Item was added:
+ ----- Method: DocLibrary class>>properStemFor: (in category 'as yet unclassified') -----
+ properStemFor: classAndMethod
+ 	"Put 'class method' into proper form as a file name.  Leave upper and lower case.  The fileName must be short enough and have proper characters for all platforms and servers."
+ 
+ 	| sz |
+ 	classAndMethod size > 23 ifTrue: ["too long"
+ 		sz _ classAndMethod size.
+ 		"input contains space and :, not . and ;"
+ 		^ (classAndMethod copyFrom: 1 to: 2), 
+ 			((classAndMethod copyFrom: 3 to: sz//2) crc16 printString),
+ 			((classAndMethod copyFrom: sz//2+1 to: sz) crc16 printString)
+ 		].
+ 	^ (classAndMethod copyReplaceAll: ' ' with: '.')
+ 		copyReplaceAll: ':' with: ';'
+ !

Item was added:
+ ----- Method: DocLibrary>>absorbAfter:from: (in category 'database of updates') -----
+ absorbAfter: oldVersion from: fileName
+ 	"Read the .ix file and add to the methodVersions database.  See class comment."
+ 
+ 	| server aUrl strm newUpdate newName prevFile classAndMethod updateID key verList new |
+ 	server _ ServerDirectory serverInGroupNamed: group.
+ 		"later try multiple servers"
+ 	aUrl _ server altUrl, 'docpane/', fileName.
+ 	strm _ HTTPSocket httpGetNoError: aUrl
+ 		args: nil accept: 'application/octet-stream'.
+ 	strm class == RWBinaryOrTextStream ifFalse: [^ false].
+ 
+ 	(strm upTo: $ ) = 'External' ifFalse: [strm close. ^ false].
+ 	newUpdate _ Integer readFrom: strm.
+ 	newUpdate = oldVersion ifTrue: [strm close. ^ false].		"already have it"
+  	strm upTo: $'.
+ 	newName _ strm nextDelimited: $'.  strm upTo: Character cr.
+ 	prevFile _ strm upTo: Character cr.
+ 	"does this report on updates just after what I know?"
+ 	oldVersion = (prevFile splitInteger first) ifFalse: [
+ 		strm close. ^ prevFile].	"see earlier sucessor file"
+ 	[strm atEnd] whileFalse: [
+ 		strm upTo: $'.
+ 		classAndMethod _ strm nextDelimited: $'.  strm next.
+ 		updateID _ Integer readFrom: strm.
+ 		key _ DocLibrary properStemFor: classAndMethod.
+ 		verList _ methodVersions at: key ifAbsent: [#()].
+ 		(verList includes: updateID) ifFalse: [
+ 			new _ verList, (Array with: updateID with: -1 "file date seen").
+ 			methodVersions at: key put: new]].
+ 	strm close.
+ 	lastUpdate _ newUpdate.
+ 	lastUpdateName _ newName.
+ 	^ true!

Item was added:
+ ----- Method: DocLibrary>>assureCacheFolder (in category 'doc pane') -----
+ assureCacheFolder
+ 	"Make sure there is a folder docPaneCache and a file: url for it in DocsCachePath.  In local folder or one level up.  User may wish to install a different path and folder name (as a url).  Could be a url to a local server."
+ 
+ 	| dir local |
+ 	DocsCachePath ifNil: [
+ 		dir _ FileDirectory default.
+ 		(dir includesKey: 'docPaneCache') ifTrue: [
+ 			DocsCachePath _ dir url, 'docPaneCache/']].
+ 	DocsCachePath ifNil: [
+ 		dir _ FileDirectory default containingDirectory.
+ 		DocsCachePath _ dir url, 'docPaneCache/'.
+ 		(dir includesKey: 'docPaneCache') ifFalse: [
+ 			^ dir createDirectory: 'docPaneCache']].	"create the folder"
+ 	local _ ServerDirectory new fullPath: DocsCachePath.
+ 	local exists ifFalse: [
+ 		DocsCachePath _ nil.	"we must be on a new disk"
+ 		self assureCacheFolder].!

Item was added:
+ ----- Method: DocLibrary>>cache:as: (in category 'doc pane') -----
+ cache: strm as: fileName
+ 	"Save the file locally in case the network is not available."
+ 
+ 	| local |
+ 	local _ ServerDirectory new fullPath: DocsCachePath.
+ 	(local fileNamed: fileName) nextPutAll: strm contents; close.!

Item was added:
+ ----- Method: DocLibrary>>docNamesAt: (in category 'doc pane') -----
+ docNamesAt: classAndMethod
+ 	"Return a list of fileNames to try for this method.  'Point x:' is form of classAndMethod."
+ 
+ 	| key verList fileNames |
+ 	key _ DocLibrary properStemFor: classAndMethod.
+ 	verList _ methodVersions at: key ifAbsent: [#()].
+ 	fileNames _ OrderedCollection new.
+ 	1 to: verList size by: 2 do: [:ind |
+ 		fileNames addFirst: key,'.',(verList at: ind) printString, '.sp'].
+ 	fileNames addLast: key,'.0.sp'.
+ 	^ fileNames!

Item was added:
+ ----- Method: DocLibrary>>docNamesAt:asOf: (in category 'doc pane') -----
+ docNamesAt: classAndMethod asOf: currentUpdate
+ 	"Return a list of fileNames to try for this method.  'Point x:' is form of classAndMethod."
+ 
+ 	| key verList fileNames |
+ 	key _ DocLibrary properStemFor: classAndMethod.
+ 	verList _ methodVersions at: key ifAbsent: [#()].
+ 	fileNames _ OrderedCollection new.
+ 	1 to: verList size by: 2 do: [:ind |
+ 		(verList at: ind) <= currentUpdate ifTrue: [
+ 			fileNames addFirst: key,'.',(verList at: ind) printString, '.sp']].
+ 	fileNames addLast: key,'.0.sp'.
+ 	^ fileNames!

Item was added:
+ ----- Method: DocLibrary>>docObjectAt: (in category 'doc pane') -----
+ docObjectAt: classAndMethod
+ 	"Return a morphic object that is the documentation pane for this method.  nil if none can be found.  Look on both the network and the disk."
+ 
+ 	| fileNames server aUrl strm local obj |
+ 	methodVersions size = 0 ifTrue: [self updateMethodVersions].	"first time"
+ 	fileNames _ self docNamesAt: classAndMethod.
+ 	self assureCacheFolder.
+ 	"server _ (ServerDirectory serverInGroupNamed: group) clone."  "Note: directory ends with '/updates' which needs to be '/docpane', but altUrl end one level up"
+ 	server _ ServerDirectory serverInGroupNamed: group.
+ 		"later try multiple servers"
+ 	aUrl _ server altUrl, 'docpane/'.
+ 	fileNames do: [:aVersion | 
+ 		strm _ HTTPSocket httpGetNoError: aUrl,aVersion 
+ 			args: nil accept: 'application/octet-stream'.
+ 		strm class == RWBinaryOrTextStream ifTrue: [
+ 			self cache: strm as: aVersion.
+ 			strm reset.
+ 			obj _ strm fileInObjectAndCode asMorph.
+ 			(obj valueOfProperty: #classAndMethod) = classAndMethod ifFalse: [
+ 				self inform: 'suspicious object'.
+ 				obj setProperty: #classAndMethod toValue: classAndMethod].
+ 			^ obj].	"The pasteUpMorph itself"
+ 		"If file not there, error 404, just keep going"].
+ 	local _ ServerDirectory new fullPath: DocsCachePath.
+ 	"check that it is really there -- let user respecify"
+ 	fileNames do: [:aVersion | 
+ 		(local includesKey: aVersion) ifTrue: [
+ 			strm _ local readOnlyFileNamed: aVersion.
+ 			obj _ strm fileInObjectAndCode asMorph.
+ 			(obj valueOfProperty: #classAndMethod) = classAndMethod ifFalse: [
+ 				self inform: 'suspicious object'.
+ 				obj setProperty: #classAndMethod toValue: classAndMethod].
+ 			Transcript cr; show: 'local cache: ', aVersion.
+ 			^ obj].	"The pasteUpMorph itself"
+ 		"If file not there, just keep looking"].
+ 	"Never been documented"
+ 	^ nil!

Item was added:
+ ----- Method: DocLibrary>>fetchDocSel:class: (in category 'doc pane') -----
+ fetchDocSel: aSelector class: className
+ 	"Look on servers to see if there is documentation pane for the selected message. Take into account the current update number.  If not, ask the user if she wants to create a blank one."
+ 
+ 	| key response docPane ext |
+ 	key _ aSelector size = 0 
+ 		ifFalse: [className, ' ', aSelector]
+ 		ifTrue: [className].
+ 	(self openDocAt: key) ifNil: [
+ 		response _ (PopUpMenu labels: 'Create new page\Cancel' withCRs)
+ 				startUpWithCaption: 'No documentation exists for this method.\
+ Would you like to write some?' withCRs.
+ 		response = 1 ifTrue: [
+ 			docPane _ PasteUpMorph new.
+ 			docPane color: Color white; borderWidth: 2; borderColor: Color green.
+ 			docPane setProperty: #classAndMethod toValue: key.
+ 			docPane setProperty: #initialExtent toValue: (ext _ 200 at 200).
+ 			docPane topLeft: (RealEstateAgent initialFrameFor: docPane world: Smalltalk currentWorld) origin.
+ 			docPane extent: ext.
+ 			docPane addMorph: (TextMorph new topLeft: docPane topLeft + (10 at 10);
+ 					extent: docPane width - 15 @ 30).
+ 			Smalltalk currentWorld addMorph: docPane]].
+ 
+ 	"If found, openDocAt: put it on the screen"!

Item was added:
+ ----- Method: DocLibrary>>initialize (in category 'initialize') -----
+ initialize
+ 	lastUpdate _ 0.
+ 	methodVersions _ Dictionary new.!

Item was added:
+ ----- Method: DocLibrary>>openDocAt: (in category 'doc pane') -----
+ openDocAt: classAndMethod
+ 
+ 	| docPane |
+ 	(docPane _ self docObjectAt: classAndMethod) ifNotNil: [
+ 		docPane setProperty: #initialExtent toValue: docPane bounds extent.
+ 		docPane topLeft: (RealEstateAgent initialFrameFor: docPane world: Smalltalk currentWorld) origin.
+ 		Smalltalk currentWorld addMorph: docPane].
+ 	^ docPane!

Item was added:
+ ----- Method: DocLibrary>>saveDoc: (in category 'doc pane') -----
+ saveDoc: aMorph
+ 	"Broadcast this documentation to the Squeak community.  Associate it with the method it documents.  Send to a drop box, where it can be inspected before being posted on External servers."
+ 
+ 	| classAndMethod fName remoteFile |
+ 	classAndMethod _ aMorph valueOfProperty: #classAndMethod.
+ 	classAndMethod ifNil: [
+ 		^ self error: 'need to know the class and method'].	"later let user set it"
+ 	fName _ (self docNamesAt: classAndMethod) first.
+ 	DropBox user asLowercase = 'anonymous' ifTrue: [
+ 		fName _ fName, 1000 atRandom printString].	"trusted users store directly"
+ 	DropBox password.	"In case user has to type it.  Avoid timeout from server"
+ 	Cursor wait showWhile: [
+ 		remoteFile _ DropBox fileNamed: fName.
+ 		remoteFile fileOutClass: nil andObject: aMorph.
+ 		"remoteFile close"].
+ !

Item was added:
+ ----- Method: DocLibrary>>saveDocCheck: (in category 'doc pane') -----
+ saveDocCheck: aMorph
+ 	"Make sure the document gets attached to the version of the code that the user was looking at.  Is there a version of this method in a changeSet beyond the updates we know about?  Works even when the user has internal update numbers and the documentation is for external updates (It always is)."
+ 
+ 	| classAndMethod parts selector class lastUp beyond ours docFor unNum ok key verList ext response |
+ 	classAndMethod _ aMorph valueOfProperty: #classAndMethod.
+ 	classAndMethod ifNil: [
+ 		^ self error: 'need to know the class and method'].	"later let user set it"
+ 	parts _ classAndMethod findTokens: ' .'.
+ 	selector _ parts last asSymbol.
+ 	class _ Smalltalk at: (parts first asSymbol) ifAbsent: [^ self saveDoc: aMorph].
+ 	parts size = 3 ifTrue: [class _ class class].
+ 	"Four indexes we are looking for:
+ 		docFor = highest numbered below lastUpdate that has method.
+ 		unNum = a higher unnumbered set that has method.
+ 		lastUp = lastUpdate we know about in methodVersions
+ 		beyond = any set about lastUp that has the method."
+ 	ChangeSorter allChangeSets doWithIndex: [:cs :ind | "youngest first"
+ 		(cs name includesSubString: lastUpdateName) ifTrue: [lastUp _ ind].
+ 		(cs atSelector: selector class: class) ~~ #none ifTrue: [
+ 			lastUp ifNotNil: [beyond _ ind. ours _ cs name]
+ 				ifNil: [cs name first isDigit ifTrue: [docFor _ ind] 
+ 						ifFalse: [unNum _ ind. ours _ cs name]]]].
+ 	"See if version the user sees is the version he is documenting"
+ 	ok _ beyond == nil.
+ 	unNum ifNotNil: [docFor ifNotNil: [ok _ docFor > unNum]
+ 						ifNil: [ok _ false]].  "old changeSets gone"
+ 	ok ifTrue: [^ self saveDoc: aMorph].
+ 
+ 	key _ DocLibrary properStemFor: classAndMethod.
+ 	verList _ (methodVersions at: key ifAbsent: [#()]), #(0 0).
+ 	ext _ verList first.	"external update number we will write to"
+ 	response _ (PopUpMenu labels: 'Cancel\Broadcast Page' withCRs)
+ 				startUpWithCaption: 'You are documenting a method in External Update ', ext asString, '.\There is a more recent version of that method in ' withCRs, ours, 
+ '.\If you are explaining the newer version, please Cancel.\Wait until that version appears in an External Update.' withCRs.
+ 	response = 2 ifTrue: [self saveDoc: aMorph].
+ !

Item was added:
+ ----- Method: DocLibrary>>scan:updateID: (in category 'database of updates') -----
+ scan: updateStream updateID: updateID
+ 	"Scan this update file and remember the update numbers of the methods."
+ 
+ 	| changeList ee semi key verList new |
+ 	updateStream reset; readOnly.
+ 	Cursor read showWhile:
+ 		[changeList _ ChangeList new
+ 			scanFile: updateStream from: 0 to: updateStream size].
+ 	changeList list do: [:entry |
+ 		ee _ nil.
+ 		(entry beginsWith: 'method: ') ifTrue: [
+ 			(semi _ entry indexOf: $;) = 0 
+ 				ifTrue: [semi _ entry size]
+ 				ifFalse: [semi _ semi-1].
+ 			ee _ entry copyFrom: 9 to: semi].
+ 		(entry beginsWith: 'class comment for ') ifTrue: [
+ 			(semi _ entry indexOf: $;) = 0 
+ 				ifTrue: [semi _ entry size]
+ 				ifFalse: [semi _ semi-1].
+ 			ee _ entry copyFrom: 19 to: semi].	"comment for whole class"
+ 		ee ifNotNil: [
+ 			key _ DocLibrary properStemFor: ee.
+ 			Transcript show: key; cr.
+ 			verList _ methodVersions at: key ifAbsent: [#()].
+ 			(verList includes: updateID) ifFalse: [
+ 				new _ verList, (Array with: updateID with: -1 "file date seen").
+ 				methodVersions at: key put: new]].
+ 		].!

Item was added:
+ ----- Method: DocLibrary>>scan:updateID:writeOn: (in category 'database of updates') -----
+ scan: updateStream updateID: updateID writeOn: strm
+ 	"Scan this update file and remember the update numbers of the methods."
+ 
+ 	| changeList ee semi |
+ 	updateStream reset; readOnly.
+ 	Cursor read showWhile:
+ 		[changeList _ ChangeList new
+ 			scanFile: updateStream from: 0 to: updateStream size].
+ 	changeList list do: [:entry |
+ 		ee _ nil.
+ 		(entry beginsWith: 'method: ') ifTrue: [
+ 			(semi _ entry indexOf: $;) = 0 
+ 				ifTrue: [semi _ entry size]
+ 				ifFalse: [semi _ semi-1].
+ 			ee _ entry copyFrom: 9 to: semi].
+ 		(entry beginsWith: 'class comment for ') ifTrue: [
+ 			(semi _ entry indexOf: $;) = 0 
+ 				ifTrue: [semi _ entry size]
+ 				ifFalse: [semi _ semi-1].
+ 			ee _ entry copyFrom: 19 to: semi].	"comment for whole class"
+ 		ee ifNotNil: [
+ 			Transcript show: ee; cr.
+ 			strm cr; nextPutAll: ee surroundedBySingleQuotes; space;
+ 				nextPutAll: updateID asString].
+ 		].!

Item was added:
+ ----- Method: DocLibrary>>scanFolder:from: (in category 'database of updates') -----
+ scanFolder: directoryUrl from: updateID
+ 	"Scan all update files in the directory starting at updateID+1.  updates.list must be present to tell us the file names."
+ 
+ 	| updateList line num |
+ 	updateList _ (ServerFile new fullPath: directoryUrl,'updates.list') asStream.
+ 	[line _ updateList upTo: Character cr.
+ 	updateList atEnd] whileFalse: [
+ 		line first isDigit ifTrue: [
+ 			num _ line splitInteger first.
+ 			num > updateID ifTrue: [
+ 				self scan: (ServerFile new fullPath: directoryUrl,line) asStream
+ 					updateID: num]
+ 			]].
+ 	lastUpdate <= num ifTrue: [
+ 		lastUpdate _ num.
+ 		lastUpdateName _ line splitInteger last].
+ 
+ !

Item was added:
+ ----- Method: DocLibrary>>scanUpdatesIn: (in category 'database of updates') -----
+ scanUpdatesIn: directoryUrl
+ 	"Scan all update files in the directory starting at lastUpdate+1.  Create a .ix file on my local hard disk.  updates.list must be present to tell us the file names."
+ 
+ 	| updateList line num temp out |
+ 	updateList _ (ServerFile new fullPath: directoryUrl,'updates.list') asStream.
+ 	temp _ WriteStream on: (String new: 2000).
+ 	[line _ updateList upTo: Character cr.
+ 	updateList atEnd] whileFalse: [
+ 		line first isDigit ifTrue: [
+ 			num _ line splitInteger first.
+ 			num > lastUpdate ifTrue: [
+ 				self scan: (ServerFile new fullPath: directoryUrl,line) asStream
+ 					updateID: num writeOn: temp]
+ 			]].
+ 	num >= lastUpdate ifTrue: [
+ 		out _ FileStream newFileNamed: 'to', num asString, '.ix'.
+ 		out nextPutAll: 'External ', num asString; space. 
+ 		line splitInteger last storeOn: out.	"quoted"
+ 		out cr; nextPutAll: lastUpdate asString, '.ix' "; cr".	"temp begins with cr"
+ 		out nextPutAll: temp contents; close.
+ 		self inform: 'Rename latest.ix to ', lastUpdate asString, 
+ 			'.ix on both external servers.
+ Put to', num asString, '.ix on both and call it latest.ix'].
+ 	!

Item was added:
+ ----- Method: DocLibrary>>setUp (in category 'initialize') -----
+ setUp
+ 	"set up the External version"
+ 	| email |
+ 	self initialize.
+ 	External _ self.
+ 	group _ 'Squeak Public Updates'.	"right for http, but not for ftp"
+ 	lastUpdate _ 599.
+ 	lastUpdateName _ 'MTMcontainsPoint-ar.cs'.
+ 	DropBox _ ServerDirectory new.
+ 	DropBox server: 'squeak.cs.uiuc.edu'; directory: 'incoming'.
+ 	DropBox type: #ftp.
+ 	email _ nil.  "Celeste popUserName."	"If nil, we ask at drop time"
+ 	DropBox user: 'anonymous'; password: email.
+ 	DropBox moniker: 'Doc Pane DropBox'.
+ 		"later allow a second server"
+ !

Item was added:
+ ----- Method: DocLibrary>>updateMethodVersions (in category 'database of updates') -----
+ updateMethodVersions
+ 	"See if any new updates have occurred, and put their methods into the database."
+ 
+ 	| indexFile list result |
+ 	indexFile _ 'latest.ix'.
+ 	list _ OrderedCollection new.
+ 	[result _ self absorbAfter: lastUpdate from: indexFile.
+ 	"boolean if succeeded, or we are up to date, or server not available"
+ 	 result isString] whileTrue: [
+ 		"result is the prev file name"
+ 		list addFirst: indexFile.
+ 		indexFile _ result].
+ 	list do: [:aFile | self absorbAfter: lastUpdate from: aFile].
+ 		"should always work this time"
+ !

Item was added:
+ RectangleMorph subclass: #DoubleClickExample
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Demo'!
+ 
+ !DoubleClickExample commentStamp: '<historical>' prior: 0!
+ Illustrates the double-click capabilities of Morphic.
+ 
+ If you have a kind of morph you wish to have respond specially to a double-click, it should:
+ 
+ (1)  Respond "true" to #handlesMouseDown:
+ 
+ (2)  In its mouseDown: method, send #waitForClicksOrDrag:event: to the hand.
+ 
+ (3)  Reimplement #click: to react to single-clicked mouse-down.
+ 
+ (4)  Reimplement #doubleClick: to make the appropriate response to a double-click.
+ 
+ (5)  Reimplement #drag: to react to non-clicks.  This message is sent continuously until the button is released.  You can check the event argument to react differently on the first, intermediate, and last calls.!

Item was added:
+ ----- Method: DoubleClickExample class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName:	'DoubleClick' translatedNoop
+ 		categories:		#()
+ 		documentation:	'An example of how to use double-click in moprhic' translatedNoop!

Item was added:
+ ----- Method: DoubleClickExample>>balloonText (in category 'accessing') -----
+ balloonText
+ 	^ 'Double-click on me to change my color; 
+ single-click on me to change border color;
+ hold mouse down within me and then move it to grow 
+ (if I''m red) or shrink (if I''m blue).' translated
+ !

Item was added:
+ ----- Method: DoubleClickExample>>click: (in category 'event handling') -----
+ click: evt
+ 	self showBalloon: 'click' hand: evt hand.
+ 	self borderColor: (self borderColor = Color black ifTrue: [Color yellow] ifFalse: [Color black])
+ !

Item was added:
+ ----- Method: DoubleClickExample>>defaultColor (in category 'initialization') -----
+ defaultColor
+ "answer the default color/fill style for the receiver"
+ 	^ Color red!

Item was added:
+ ----- Method: DoubleClickExample>>doubleClick: (in category 'event handling') -----
+ doubleClick: evt
+ 	self showBalloon: 'doubleClick' hand: evt hand.
+ 	self color: ((color = Color blue) ifTrue: [Color red] ifFalse: [Color blue])
+ !

Item was added:
+ ----- Method: DoubleClickExample>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: evt
+ 	^ true!

Item was added:
+ ----- Method: DoubleClickExample>>mouseDown: (in category 'event handling') -----
+ mouseDown: evt
+ 	"Do nothing upon mouse-down except inform the hand to watch for a double-click; wait until an ensuing click:, doubleClick:, or drag: message gets dispatched"
+ 
+ 	evt hand waitForClicksOrDrag: self event: evt!

Item was added:
+ ----- Method: DoubleClickExample>>startDrag: (in category 'event handling') -----
+ startDrag: evt
+ 	"We'll get a mouseDown first, some mouseMoves, and a mouseUp event last"
+ 	| oldCenter |
+ 	evt isMouseDown ifTrue:
+ 		[self showBalloon: 'drag (mouse down)' hand: evt hand.
+ 		self world displayWorld.
+ 		(Delay forMilliseconds: 750) wait].
+ 	evt isMouseUp ifTrue:
+ 		[self showBalloon: 'drag (mouse up)' hand: evt hand].
+ 	(evt isMouseUp or: [evt isMouseDown]) ifFalse:
+ 		[self showBalloon: 'drag (mouse still down)' hand: evt hand].
+ 	(self containsPoint: evt cursorPoint)
+ 		ifFalse: [^ self].
+ 
+ 	oldCenter _ self center.
+ 	color = Color red
+ 		ifTrue:
+ 			[self extent: self extent + (1 at 1)]
+ 		ifFalse:
+ 			[self extent: ((self extent - (1 at 1)) max: (16 at 16))].
+ 	self center: oldCenter!

Item was added:
+ Morph subclass: #DownloadingImageMorph
+ 	instanceVariableNames: 'url altText defaultExtent image downloadQueue imageMapName formatter'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Formatter'!
+ 
+ !DownloadingImageMorph commentStamp: '<historical>' prior: 0!
+ a placeholder for an image that is downloading!

Item was added:
+ ----- Method: DownloadingImageMorph>>altText: (in category 'as yet unclassified') -----
+ altText: aString
+ 	"set the text to be displayed while downloading"
+ 	altText _ aString.
+ 	aString ifNotNil: [self setBalloonText: aString].
+ 	self setContents!

Item was added:
+ ----- Method: DownloadingImageMorph>>defaultExtent: (in category 'as yet unclassified') -----
+ defaultExtent: aPoint
+ 	"set the size to use when the image hasn't yet downloaded"
+ 	defaultExtent _ aPoint!

Item was added:
+ ----- Method: DownloadingImageMorph>>downloadStateIn: (in category 'as yet unclassified') -----
+ downloadStateIn: aScamper
+ 	"download the image"
+ 	| doc |
+ 	doc _ url retrieveContents.
+ 	downloadQueue nextPut: doc.
+ 
+ !

Item was added:
+ ----- Method: DownloadingImageMorph>>forkDownloadWhenFinished: (in category 'as yet unclassified') -----
+ forkDownloadWhenFinished: aBlock 
+ 	| doc |
+ 	image ifNotNil: [^self].
+ 	self setContents.
+ 	[
+ 		[
+ 			doc := url retrieveContents.
+ 			(doc notNil and: [doc mainType = 'image'])
+ 				ifTrue: [image := ImageReadWriter formFromStream: doc contentStream binary].
+ 		] ifError: [].
+ 		WorldState addDeferredUIMessage:
+ 			[image ifNotNil: [self setContents].
+ 			self stopStepping.
+ 			aBlock value]
+ 	] forkAt: Processor userBackgroundPriority!

Item was added:
+ ----- Method: DownloadingImageMorph>>formatter (in category 'accessing') -----
+ formatter
+ 	^formatter!

Item was added:
+ ----- Method: DownloadingImageMorph>>formatter: (in category 'accessing') -----
+ formatter: aFormatter
+ 	formatter _ aFormatter!

Item was added:
+ ----- Method: DownloadingImageMorph>>imageMapName (in category 'accessing') -----
+ imageMapName
+ 	^imageMapName!

Item was added:
+ ----- Method: DownloadingImageMorph>>imageMapName: (in category 'accessing') -----
+ imageMapName: aString
+ 	imageMapName _ aString!

Item was added:
+ ----- Method: DownloadingImageMorph>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 	super initialize.
+ 
+ 	altText _ '[image]'.
+ 	self color: Color transparent.
+ 	downloadQueue _ SharedQueue new.!

Item was added:
+ ----- Method: DownloadingImageMorph>>setContents (in category 'as yet unclassified') -----
+ setContents
+ 	"set up our morphic contents"
+ 	| imageMorph imageMap |
+ 	self removeAllMorphs.
+ 
+ 	image ifNil: [^self setNoImageContents].
+ 
+ 	defaultExtent isNil
+ 		ifTrue: [(imageMorph _ ImageMorph new) image: image]
+ 		ifFalse: [imageMorph := SketchMorph withForm: image].
+ 	(imageMapName notNil
+ 	and: [formatter notNil
+ 	and: [(imageMap _ formatter imageMapNamed: imageMapName) notNil]])
+ 		ifTrue: [imageMap buildImageMapForImage: imageMorph andBrowser: formatter browser].
+ 
+ 	imageMorph position: self position.
+ 	self addMorph: imageMorph.
+ 	defaultExtent isNil
+ 		ifFalse: [imageMorph extent: defaultExtent].
+ 	self extent ~= imageMorph extent
+ 		ifTrue: [	self extent: imageMorph extent ]!

Item was added:
+ ----- Method: DownloadingImageMorph>>setNoImageContents (in category 'as yet unclassified') -----
+ setNoImageContents
+ 	"set up our morphic contents in case image download/decoding failed"
+ 	| stringMorph outlineMorph extent |
+ 	altText isEmptyOrNil
+ 		ifTrue: [ self extent: 0 at 0. "don't display anything..." ^self ].
+ 
+ 	stringMorph _ StringMorph new.
+ 	stringMorph contents: altText.
+ 	stringMorph position: self position+(2 at 2).
+ 	self addMorph: stringMorph.
+ 
+ 	outlineMorph _ RectangleMorph new.
+ 	outlineMorph borderWidth: 1.
+ 	outlineMorph color: Color transparent.
+ 	outlineMorph position: self position.
+ 
+ 	"figure out how big to make the box"
+ 	extent _ defaultExtent ifNil: [ 0 @ 0 ].
+ 	stringMorph width + 4 > extent x ifTrue: [
+ 		extent _ (stringMorph width + 4) @ extent y ].
+ 	stringMorph height + 4 > extent y ifTrue: [
+ 		extent _ extent x @ (stringMorph height + 4) ].
+ 	outlineMorph extent: extent.
+ 	self addMorph: outlineMorph.
+ 
+ 	self extent: outlineMorph extent
+ !

Item was added:
+ ----- Method: DownloadingImageMorph>>step (in category 'as yet unclassified') -----
+ step
+ 	| doc |
+ 	downloadQueue size > 0 ifTrue: [
+ 		doc _ downloadQueue next.
+ 		(doc notNil and: [doc mainType = 'image'])
+ 		ifTrue: [
+ 			[image _ ImageReadWriter  formFromStream: doc contentStream binary]
+ 				ifError: [:err :rcvr | "ignore" image _ nil].
+ 			self setContents ] ].!

Item was added:
+ ----- Method: DownloadingImageMorph>>stepTime (in category 'as yet unclassified') -----
+ stepTime
+ 	"this check doesn't need to be frequent"
+ 	^500!

Item was added:
+ ----- Method: DownloadingImageMorph>>url: (in category 'as yet unclassified') -----
+ url: aUrl
+ 	"set the url to download"
+ 	url _ aUrl asUrl.!

Item was added:
+ Morph subclass: #DrawErrorMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Experimental'!
+ 
+ !DrawErrorMorph commentStamp: '<historical>' prior: 0!
+ This morph simply invokes errors during drawing and stepping.!

Item was added:
+ ----- Method: DrawErrorMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 	aCanvas error:'DrawErrorMorph drawOn: invoked'!

Item was added:
+ ----- Method: DrawErrorMorph>>printOn: (in category 'printing') -----
+ printOn: aStream
+ 	"Indirectly invokes an error during stepping in an Inspector"
+ 	aStream error:'DrawErrorMorph>>printOn: invoked'!

Item was added:
+ ----- Method: DropEvent>>buttons (in category '*Etoys-Squeakland-accessing') -----
+ buttons
+ 	^ 0!

Item was added:
+ ----- Method: EFontBDFFontReaderForRanges class>>rangesForRussian (in category '*Etoys-Squeakland-as yet unclassified') -----
+ rangesForRussian
+ 
+ 	^ {
+ 		Array with: 16r1 with: 16rFF.
+ 		Array with: 16r400 with: 16r513.
+ 		Array with: 16r2219 with: 16r2219.
+ 		Array with: 16r221A with: 16r221A.
+ 		Array with: 16r2248 with: 16r2248.
+ 		Array with: 16r2264 with: 16r2265.
+ 		Array with: 16r2320 with: 16r2321.
+ 		Array with: 16r2500 with: 16r25A0.
+ 	}.
+ !

Item was added:
+ ----- Method: EFontBDFFontReaderForRanges>>additionalRangesForSimplifiedChinese (in category '*Etoys-Squeakland-as yet unclassified') -----
+ additionalRangesForSimplifiedChinese
+ 
+ 	| basics |
+ 	basics _ {
+ 		{16rFF00. 16rFF60}
+ }.
+ 	^ basics
+ !

Item was added:
+ ----- Method: EFontBDFFontReaderForRanges>>override2:with:ranges:transcodingTable:additionalRange: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ override2: chars with: otherFileName ranges: pairArray transcodingTable: table additionalRange: additionalRanges
+ 
+ 	| other newChars form u j in newArray |
+ 	other _ BDFFontReader readOnlyFileNamed: otherFileName.
+ 
+ 	newChars _ PluggableSet new.
+ 	newChars hashBlock: [:elem | (elem at: 2) hash].
+ 	newChars equalBlock: [:a :b | (a at: 2) = (b at: 2)].
+ 
+ 	other readChars do: [:array | 
+ 		j _ array at: 2.
+ 		u _ table at: (((j // 256) - 33 * 94 + ((j \\ 256) - 33)) + 1).
+ 		u ~= -1 ifTrue: [
+ 			u hex printString displayAt: 0 at 0.
+ 			in _ false.
+ 			pairArray do: [:pair |
+ 				(u between: pair first and: pair second) ifTrue: [
+ 					in _ true
+ 				]
+ 			].
+ 			in ifTrue: [
+ 				form _ array at: 1.
+ 				form ifNotNil: [
+ 					newArray _ array clone.
+ 					newArray at: 2 put: u.
+ 					newChars add: newArray.
+ 				].
+ 			].
+ 		].
+ 	].
+ 
+ 	newChars addAll: chars.
+ 	^ newChars.
+ !

Item was added:
+ ----- Method: EFontBDFFontReaderForRanges>>rangesForSimplifiedChinese (in category '*Etoys-Squeakland-as yet unclassified') -----
+ rangesForSimplifiedChinese
+ 
+ 	| basics etc |
+ 	basics _ {
+ 		Array with: 16rA1 with: 16rFF
+ 	}.
+ 	etc _ {
+ 		Array with: 16r100 with: 16r17F. "extended latin"
+ 		Array with: 16r370 with: 16r3FF. "greek"
+ 		Array with: 16r400 with: 16r52F. "cyrillic"
+ 		Array with: 16r2000 with: 16r206F. "general punctuation"
+ 		Array with: 16r2100 with: 16r214F. "letterlike"
+ 		Array with: 16r2150 with: 16r218F. "number form"
+ 		Array with: 16r2190 with: 16r21FF. "arrows"
+ 		Array with: 16r2200 with: 16r22FF. "math operators"
+ 		Array with: 16r2300 with: 16r23FF. "misc tech"
+ 		Array with: 16r2460 with: 16r24FF. "enclosed alnum"
+ 		Array with: 16r2500 with: 16r257F. "box drawing"
+ 		Array with: 16r2580 with: 16r259F. "box elem"
+ 		Array with: 16r25A0 with: 16r25FF. "geometric shapes"
+ 		Array with: 16r2600 with: 16r26FF. "misc symbols"
+ 		Array with: 16r3000 with: 16r303F. "cjk symbols"
+ 		Array with: 16r3040 with: 16r309F. "hiragana"
+ 		Array with: 16r30A0 with: 16r30FF. "katakana"
+ 		Array with: 16r3190 with: 16r319F. "kanbun"
+ 		Array with: 16r31F0 with: 16r31FF. "katakana extension"
+ 		Array with: 16r3200 with: 16r32FF. "enclosed CJK"
+ 		Array with: 16r3300 with: 16r33FF. "CJK compatibility"
+ 		Array with: 16r4E00 with: 16r9FAF. "CJK ideograph"
+ 		Array with: 16rAC00 with: 16rD7AF. "Hangul Syllables"
+ 		Array with: 16rF900 with: 16rFAFF. "CJK compatiblity ideograph"
+ 		Array with: 16rFF00 with: 16rFFEF. "half and full"
+ 	}.
+ 
+ 	^ basics, etc.
+ !

Item was added:
+ ----- Method: EFontBDFFontReaderForRanges>>readCharactersInRanges2:storeInto: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ readCharactersInRanges2: ranges storeInto: chars
+ 
+ 	| array form code rangeStream in |
+ 	rangeStream _ ReadStream on: ranges.
+ 	[true] whileTrue: [
+ 		array _ self readOneCharacter.
+ 		array second ifNil: [^ self].
+ 		code _ array at: 2.
+ 		in _ false.
+ 		ranges do: [:range |
+ 			(code between: range first and: range last) ifTrue: [
+ 				in _ true.
+ 			].
+ 		].
+ 		in ifTrue: [
+ 			form _ array at: 1.
+ 			form ifNotNil: [
+ 				chars add: array.
+ 			].
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: EFontBDFFontReaderForRanges>>readRangesForSimplifiedChinese:overrideWith:otherRanges:additionalOverrideRange: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ readRangesForSimplifiedChinese: ranges overrideWith: otherFileName otherRanges: otherRanges additionalOverrideRange: additionalRange
+ 
+ 	| xTable strikeWidth glyphs ascent descent minAscii maxAscii maxWidth chars charsNum height form encoding bbx width blt lastAscii pointSize ret lastValue start end |
+ 	form _ encoding _ bbx _ nil.
+ 	self initialize.
+ 	self readAttributes.
+ 	height _ Integer readFromString: ((properties at: #FONTBOUNDINGBOX) at: 2).
+ 	ascent _ Integer readFromString: (properties at: 'FONT_ASCENT' asSymbol) first.
+ 	descent _ Integer readFromString: (properties at: 'FONT_DESCENT' asSymbol) first.
+ 	(properties includesKey: 'POINT_SIZE' asSymbol) ifTrue: [
+ 		pointSize _ (Integer readFromString: (properties at: 'POINT_SIZE' asSymbol) first) // 10.
+ 	] ifFalse: [
+ 		pointSize _ (ascent + descent) * 72 // 96.
+ 	].
+ 		
+ 	
+ 	maxWidth _ 0.
+ 	minAscii _ 16r200000.
+ 	strikeWidth _ 0.
+ 	maxAscii _ 0.
+ 
+ 	charsNum _ Integer readFromString: (properties at: #CHARS) first.
+ 	chars _ Set new: charsNum.
+ 
+ 	self readCharactersInRanges2: ranges storeInto: chars.
+ 	chars _ self override2: chars with: otherFileName ranges: otherRanges transcodingTable: (UCSTable jisx0208Table) additionalRange: additionalRange.
+ 
+ 	chars _ chars asSortedCollection: [:x :y | (x at: 2) <= (y at: 2)].
+ 	charsNum _ chars size. "undefined encodings make this different"
+ 	
+ 	chars do: [:array |
+ 		encoding _ array at: 2.
+ 		bbx _ array at: 3..
+ 		width _ bbx at: 1.
+ 		maxWidth _ maxWidth max: width.
+ 		minAscii _ minAscii min: encoding.
+ 		maxAscii _ maxAscii max: encoding.
+ 		strikeWidth _ strikeWidth + width.
+ 	].
+ 
+ 	glyphs _ Form extent: strikeWidth at height.
+ 	blt _ BitBlt toForm: glyphs.
+ 	start _ ((ranges collect: [:r | r first]), (additionalRange collect: [:r2 | r2 first])) min.
+ 	end _ ((ranges collect: [:r | r second]), (additionalRange collect: [:r2 | r2 second])) max + 3.
+ 	"xRange _ Array with: (Array with: ((ranges collect: [:r | r first]), (additionalRange collect: [:r2 | r2 first])) min
+ 						with: (((ranges collect: [:r | r second]), (additionalRange collect: [:r2 | r2 second])) max + 2))."
+ 	"xTable _ XTableForUnicodeFont new
+ 		ranges: xRange."
+ 	xTable _ SparseLargeTable new: end chunkSize: 64 arrayClass: Array base: start defaultValue: -1.
+ 	lastAscii _ start.
+ 	xTable at: lastAscii + 2 put: 0.
+ 	1 to: charsNum do: [:i |
+ 		form _ (chars at: i) first.
+ 		encoding _ (chars at: i) second.
+ 		bbx _ (chars at: i) third.
+ 		"lastAscii+1 to: encoding-1 do: [:a | xTable at: a+2 put: (xTable at: a+1)]."
+ 		lastValue _ xTable at: lastAscii + 1 + 1.
+ 		xTable at: encoding + 1 put: lastValue.
+ 		blt copy: (((xTable at: encoding+1)@(ascent - (bbx at: 2) - (bbx at: 4)))
+ 				extent: (bbx at: 1)@(bbx at: 2))
+ 			from: 0 at 0 in: form.
+ 		xTable at: encoding+2 put: (xTable at: encoding+1)+(bbx at: 1).
+ 		lastAscii _ encoding.
+ 	].
+ 	xTable at: xTable size put: (xTable at: xTable size - 1).
+ 	xTable zapDefaultOnlyEntries.
+ 	ret _ Array new: 8.
+ 	ret at: 1 put: xTable.
+ 	ret at: 2 put: glyphs.
+ 	ret at: 3 put: minAscii.
+ 	ret at: 4 put: maxAscii.
+ 	ret at: 5 put: maxWidth.
+ 	ret at: 6 put: ascent.
+ 	ret at: 7 put: descent.
+ 	ret at: 8 put: pointSize.
+ 	^ret.
+ " ^{xTable. glyphs. minAscii. maxAscii. maxWidth. ascent. descent. pointSize}"
+ !

Item was changed:
  ----- Method: EToyCommunicatorMorph class>>instanceReport (in category 'as yet unclassified') -----
  instanceReport	"for cleaning up Alan's demo"
  "
  EToySenderMorph instanceReport
  "
  	| answer resp |
  
  	Smalltalk garbageCollect.
+ 	answer _ self allInstances collect: [ :each |
- 	answer := self allInstances collect: [ :each |
  		{
  			each.
  			[each ipAddress] on: Error do: [ 'no ipAddress'].
  			each owner 
  					ifNil: ['* no owner *'] 
  					ifNotNil: [each owner innocuousName,' ',each owner printString].
  			each world ifNil: ['-----no project-----'] ifNotNil: [each world project name].
  		}
  	].
+ 	resp _ (PopUpMenu labels: 'IP Address\Project\Owner' translated withCRs) startUpWithCaption: 
+ 					'Sorted by' translated.
- 	resp := UIManager default chooseFrom:  {
- 		'IP Address'.
- 		'Project'.
- 		'Owner'
- 	}  title:  'Sorted by'.
  	resp = 1 ifTrue: [
  		^(answer asSortedCollection: [ :a :b | a second <= b second]) asArray explore
  	].
  	resp = 2 ifTrue: [
  		^(answer asSortedCollection: [ :a :b | a fourth <= b fourth]) asArray explore
  	].
  	resp = 3 ifTrue: [
  		^(answer asSortedCollection: [ :a :b | a third <= b third]) asArray explore
  	].
  	answer explore!

Item was changed:
  ----- Method: EToyCommunicatorMorph>>textEntryFieldNamed:with:help: (in category 'as yet unclassified') -----
  textEntryFieldNamed: aSymbol with: aString help: helpString
  
  	| f col |
+ 	f _ (StringMorph new contents: aString; font: Preferences standardEToysFont; yourself)
- 	f := (StringMorph new contents: aString)
  		setBalloonText: helpString;
  		on: #mouseUp send: #editEvent:for: to: self.
  	self field: aSymbol is: f.
+ 	col _ (self inAColumn: {f}) color: Color white; hResizing: #shrinkWrap.
- 	col := (self inAColumn: {f}) color: Color white; hResizing: #shrinkWrap.
  	^col!

Item was added:
+ Object subclass: #EToyExpressionTransformer
+ 	instanceVariableNames: 'method stack inputQueue encoder'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Compiler'!

Item was added:
+ ----- Method: EToyExpressionTransformer>>inputQueueEmpty (in category 'all') -----
+ inputQueueEmpty
+ 
+ 	^ inputQueue isEmpty!

Item was added:
+ ----- Method: EToyExpressionTransformer>>inputQueueNext (in category 'all') -----
+ inputQueueNext
+ 
+ 	| e f |
+ 	e _ inputQueue removeFirst.
+ 	inputQueue size > 0 ifTrue: [
+ 		f _ inputQueue removeFirst.
+ 		(f isMemberOf: MessageNode) ifTrue: [
+ 			self pushAMessageNode: f
+ 		] ifFalse: [
+ 			inputQueue addFirst: f
+ 		].
+ 	].
+ 	^ e.
+ 
+ 			
+ 		!

Item was added:
+ ----- Method: EToyExpressionTransformer>>inputQueuePeek (in category 'all') -----
+ inputQueuePeek
+ 
+ 	^ inputQueue size > 0 ifTrue: [inputQueue first] ifFalse: [nil]
+ !

Item was added:
+ ----- Method: EToyExpressionTransformer>>newMessageFor:encoder: (in category 'all') -----
+ newMessageFor: aMessageNode encoder: e
+ 
+ 	encoder _ e.
+ 	inputQueue _ OrderedCollection new: 3.
+ 	self pushAMessageNode: aMessageNode.
+ 	stack _ OrderedCollection new: 3.
+ !

Item was added:
+ ----- Method: EToyExpressionTransformer>>precl (in category 'all') -----
+ precl
+ 
+ 	stack size = 0 ifTrue: [^ 0].
+ 	stack size = 1 ifTrue: [^ self precl: stack last].
+ 	stack last isSymbol ifTrue: [^ 0].
+ 	^ self precl: (stack at: stack size - 1).
+ !

Item was added:
+ ----- Method: EToyExpressionTransformer>>precl: (in category 'all') -----
+ precl: anObject
+ 
+ 	(#(#max: #min:) includes: anObject) ifTrue: [^ 1].
+ 	(#(#+ #-) includes: anObject) ifTrue: [^ 2].
+ 	(#(#* #/ #// #\\) includes: anObject) ifTrue: [^ 3].
+ 	^ 0.
+ !

Item was added:
+ ----- Method: EToyExpressionTransformer>>precr: (in category 'all') -----
+ precr: anObject
+ 
+ 	anObject ifNil: [^ 0].
+ 	(#(#max: #min:) includes: anObject) ifTrue: [^ 1].
+ 	(#(#+ #-) includes: anObject) ifTrue: [^ 2].
+ 	(#(#* #/ #// #\\) includes: anObject) ifTrue: [^ 3].
+ 	^ 4.
+ !

Item was added:
+ ----- Method: EToyExpressionTransformer>>pushAMessageNode: (in category 'all') -----
+ pushAMessageNode: node
+ 
+ 	| s |
+ 	node isEToyBinaryExp ifTrue: [
+ 		inputQueue addLast: node receiver.
+ 		inputQueue addLast: ((s _ node selector) isSymbol ifTrue: [s] ifFalse: [s key]).
+ 		inputQueue addLast: node arguments first.
+ 	] ifFalse: [
+ 		inputQueue addLast: node
+ 	].
+ !

Item was added:
+ ----- Method: EToyExpressionTransformer>>reduceOnStack (in category 'all') -----
+ reduceOnStack
+ 
+ 	| list left sel right m |
+ 	list _ stack removeLast: 3.
+ 	left _ list at: 1.
+ 	sel _ list at: 2.
+ 	right _ list at: 3.
+ 
+ 	m _	 MessageNode new
+ 				receiver: left
+ 				selector: sel
+ 				arguments: (Array with: right)
+ 				precedence: (sel precedence)
+ 				from: encoder
+ 				sourceRange: nil.
+ 	stack addLast: m.
+ !

Item was added:
+ ----- Method: EToyExpressionTransformer>>transform (in category 'all') -----
+ transform
+ 
+ 	| leftPrec rightPrec n |
+ 	[(self inputQueueEmpty and: [stack size = 1]) not] whileTrue: [
+ 		leftPrec _ self precl.
+ 		rightPrec _ self precr: (n _ self inputQueuePeek).
+ 		leftPrec >= rightPrec ifTrue: [
+ 			self reduceOnStack.
+ 		] ifFalse: [
+ 			self inputQueueNext.
+ 			stack addLast: n.
+ 		].
+ 	].
+ 	^ stack last.
+ 
+ 
+ !

Item was changed:
  ----- Method: EToyExpressionTransformer2>>reduceOnStack (in category 'all') -----
  reduceOnStack
  
  	| list left sel right m |
  	list := stack removeLast: 3.
  	left := list at: 1.
  	sel := list at: 2.
  	right := list at: 3.
  
  	m :=	 MessageNode new
  				receiver: left
+ 				selector: sel key
- 				selector: sel
  				arguments: (Array with: right)
  				precedence: (sel precedence)
  				from: encoder
  				sourceRange: nil.
  	stack addLast: m.
  !

Item was added:
+ ----- Method: EToyListenerMorph class>>listeningPort (in category '*Etoys-Squeakland-as yet unclassified') -----
+ listeningPort
+ 
+ 	^GlobalListener ifNotNil: [GlobalListener listeningPort]
+ !

Item was added:
+ ----- Method: EToyListenerMorph class>>removeAllFromGlobalIncomingQueue (in category '*Etoys-Squeakland-as yet unclassified') -----
+ removeAllFromGlobalIncomingQueue
+ 
+ 	self critical: [
+ 		GlobalIncomingQueue _ OrderedCollection new.
+ 		self bumpUpdateCounter.
+ 	].!

Item was added:
+ ----- Method: EToyListenerMorph>>listeningPort (in category '*Etoys-Squeakland-as yet unclassified') -----
+ listeningPort
+ 	^self class listeningPort!

Item was added:
+ ----- Method: EToyPeerToPeer class>>eToyCommunicationsPorts (in category '*Etoys-Squeakland-as yet unclassified') -----
+ eToyCommunicationsPorts
+ 	^ 34151 to: 34159!

Item was added:
+ ----- Method: EToyPeerToPeer>>listeningPort (in category '*Etoys-Squeakland-listening') -----
+ listeningPort
+ 	^connectionQueue portNumberOrNil!

Item was added:
+ ----- Method: EToyPeerToPeer>>makeOptionalHeader (in category '*Etoys-Squeakland-sending') -----
+ makeOptionalHeader
+ 	"Optional header format is '(key:value;key:value)' and it must not contain spaces. This is designed to be backwards-compatible with old receivers who receive a header as anything up to a space, but only actually use an initial size integer"
+ 
+ 	| args p t |
+ 	args := OrderedCollection new.
+ 
+ 	p := EToyListenerMorph listeningPort.
+ 	(p notNil and: [p ~= self class eToyCommunicationsPorts first])
+ 		ifTrue: [args add: 'port:', p asString].
+ 
+ 	t := SugarLauncher current listeningTube.
+ 	t ifNotNil: [args add: 'tube:', t asString].
+ 
+ 	^args isEmpty
+ 		ifTrue: ['']
+ 		ifFalse: [String streamContents: [:strm |
+ 			strm nextPut: $(.
+ 			args
+ 				do: [:arg | strm nextPutAll: arg]
+ 				separatedBy: [strm nextPut: $;].
+ 			strm nextPut: $)]].
+ !

Item was added:
+ ----- Method: EToyPeerToPeer>>parseOptionalHeader: (in category '*Etoys-Squeakland-receiving') -----
+ parseOptionalHeader: aString
+ 	"header used to be just an integer, was extended to have optional parameters (see makeOptionalHeader)"
+ 
+ 	(((aString copyAfter: $() copyUpTo: $)) findTokens: $;) do: [:item |
+ 		(item beginsWith: 'port:')
+ 			ifTrue: [self receivedPort: (item copyAfter: $:)].
+ 		(item beginsWith: 'tube:')
+ 			ifTrue: [self receivedTube: (item copyAfter: $:)].]!

Item was added:
+ ----- Method: EToyPeerToPeer>>receivedPort: (in category '*Etoys-Squeakland-receiving') -----
+ receivedPort: aString
+ 	(remoteSocketAddress includes: $:) ifFalse: [
+ 		remoteSocketAddress := remoteSocketAddress, ':', aString].!

Item was added:
+ ----- Method: EToyPeerToPeer>>receivedTube: (in category '*Etoys-Squeakland-receiving') -----
+ receivedTube: aString
+ 	"Sender offers a tube for talking back. Get the tube's address."
+ 	| addr |
+ 	addr := SugarLauncher current socketAddressForTube: aString.
+ 	addr ifNotNil: [remoteSocketAddress := addr]!

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>ageTriplets (in category '*Etoys-Squeakland-classification accessing') -----
+ ageTriplets
+ 	"Answer a list of the triplets characterizing the 'age' categories; each triplet is of the form
+ 		(<numeric code> <string code> <english version>)"
+ 
+ 	^ AgeTriplets ifNil: [
+ 		AgeTriplets := (self cachedTripletsFor: #age)
+ 			ifNil: [self defaultAgeTriplets]]!

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>cachedTripletsFor: (in category '*Etoys-Squeakland-classification information') -----
+ cachedTripletsFor: aCategory
+ 	"Load triplets from file, e.g. '.ageCatList-de.csv' for the 'age' category"
+ 	| file  |
+ 	[
+ 		file := FileStream readOnlyFileNamed: (self tripletsFileNameFor: aCategory).
+ 		[^self tripletsFrom: file contentsOfEntireFile] ensure: [file close].
+ 	] ifError: [].
+ 	^nil
+ !

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>csvLineQuotedDecodedFor: (in category '*Etoys-Squeakland-utilities') -----
+ csvLineQuotedDecodedFor: aString
+ 	"Given that the string provided consists of items delimited by double-quotes and separated by commas, answer an array containing the individual items with quotes removed."
+ 
+ 	| openQuoteHanging readStream elementStream char |
+ 	openQuoteHanging := false.
+ 
+ 	^ Array streamContents: [:writeStream |
+ 		readStream := aString readStream.
+ 		elementStream := WriteStream on: ''.
+ 		[readStream atEnd] whileFalse:
+ 			[char := readStream next.
+ 			char = $"
+ 				ifTrue:
+ 					[openQuoteHanging
+ 						ifTrue:
+ 							[writeStream nextPut: elementStream contents.
+ 							elementStream := WriteStream on: ''.
+ 							openQuoteHanging := false]
+ 						ifFalse:
+ 							[openQuoteHanging := true]]
+ 				ifFalse:
+ 					[openQuoteHanging ifTrue:
+ 						[elementStream nextPut: char]]]]
+ 				
+ "
+ (((HTTPSocket httpGet: 'http://squeakland.org/subjectCatList' args: #() user: '' passwd: '')) contents copyReplaceAll: String lf with: String cr) lines collect: [:l | EToyProjectDetailsMorph csvLineQuotedDecodedFor: l]
+ "!

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>defaultAgeTriplets (in category '*Etoys-Squeakland-classification defaults') -----
+ defaultAgeTriplets
+ 	"Answer a default set of triplets characterizing the Age classifications"
+ 
+ 	^  #(
+ 	('556' 'showcase : by age : 6 to 8' 'Ages 6 to 8')
+ 	('558' 'showcase : by age : 9 to 11' 'Ages 9 to 11')
+ 	('559' 'showcase : by age : 12 to 14' 'Ages 12 to 14')
+ 	('560' 'showcase : by age : 15 to 18' 'Ages 15 to 18') )!

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>defaultRegionTriplets (in category '*Etoys-Squeakland-classification defaults') -----
+ defaultRegionTriplets
+ 	"Answer default triplets for the region codes"
+ 
+ 	^  #(
+ 	('619' 'showcase : by region : Africa' 'Africa')
+ 	('620' 'showcase : by region : Antarctica' 'Antarctica')
+ 	('621' 'showcase : by region : Asia' 'Asia') 
+ 	('622' 'showcase : by region : Australia' 'Australia') 
+ 	('623' 'showcase : by region : Caribbean' 'Caribbean')
+ 	('624' 'showcase : by region : Central America' 'Central America')
+ 	('625' 'showcase : by region : Europe' 'Europe') 
+ 	('626' 'showcase : by region : North America' 'North America')
+ 	('627' 'showcase : by region : Oceania' 'Oceania') 
+ 	('628' 'showcase : by region : South America' 'South America') 
+ )
+ 
+ "
+ EToyProjectDetailsMorph defaultRegionTriplets
+ "!

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>defaultSubjectTriplets (in category '*Etoys-Squeakland-classification defaults') -----
+ defaultSubjectTriplets
+ 	"Answer a default set of triplets characterizing the Subject classifications"
+ 
+ 	^  #(
+ 	('554' 'showcase : by subject : language arts' 'Language Arts')
+ 	('553' 'showcase : by subject : mathemetics' 'Mathematics')
+ 	('555' 'showcase : by subject : science' 'Science')
+ 	('860' 'showcase : by subject : social studies' 'Social Studies') 
+ 	('861' 'showcase : by subject : music' 'Music')
+ 	('862' 'showcase : by subject : visual arts' 'Visual Arts')
+ 	('863' 'showcase : by subject : health' 'Health'))!

Item was changed:
+ ----- Method: EToyProjectDetailsMorph class>>getFullInfoFor:ifValid:expandedFormat: (in category 'instance creation') -----
+ getFullInfoFor: aProject ifValid: aMessageSend expandedFormat: expandedFormat
+ 	"Obtain project info for the project by putting up a dialog-box showing current values for the various project-info variables and allowing the user to change the data."
- ----- Method: EToyProjectDetailsMorph class>>getFullInfoFor:ifValid:expandedFormat: (in category 'as yet unclassified') -----
- getFullInfoFor: aProject ifValid: aBlock expandedFormat: expandedFormat
  
+ 	| detailsMorph  |
+ 	detailsMorph := self basicNew.
+ 	detailsMorph expandedFormat: expandedFormat;
+ 		project: aProject actionBlock: aMessageSend;
- 	| me |
- 
- 	(me := self basicNew)
- 		expandedFormat: expandedFormat;
- 		project: aProject
- 		actionBlock: [ :x | 
- 			aProject world setProperty: #ProjectDetails toValue: x.
- 			x at: 'projectname' ifPresent: [ :newName | 
- 				aProject renameTo: newName.
- 			].
- 			me delete.
- 			aBlock value.
- 		];
- 
  		initialize;
  		becomeModal;
+ 		beSticky;
  		openCenteredInWorld!

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>linesIn: (in category '*Etoys-Squeakland-utilities') -----
+ linesIn: aString
+ 	"Answer an array whose elements are strings constituting the lines in the input string."
+ 
+ 	^ Array streamContents: [:aStream |
+ 		aString linesDo:
+ 			[: aLine | aStream nextPut: aLine]]
+ 
+ "
+ EToyProjectDetailsMorph linesIn: 'Fred
+ the
+ 	Bear'
+ "!

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>regionTriplets (in category '*Etoys-Squeakland-classification accessing') -----
+ regionTriplets
+ 	"Answer a list of triplets of the form (numberCode stringCode englishName) for the regions."
+ 
+ 	^ RegionTriplets ifNil: [
+ 		RegionTriplets := (self cachedTripletsFor: #region)
+ 			ifNil: [self defaultRegionTriplets]]!

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>restoreDefaultTriplets (in category '*Etoys-Squeakland-classification defaults') -----
+ restoreDefaultTriplets
+ 	"Restore the defaults obtained from cold hard code."
+ 
+ 	RegionTriplets := self defaultRegionTriplets.
+ 	AgeTriplets := self defaultAgeTriplets.
+ 	SubjectTriplets := self defaultSubjectTriplets
+ 
+ "
+ EToyProjectDetailsMorph restoreDefaultTriplets
+ "!

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>subjectTriplets (in category '*Etoys-Squeakland-classification accessing') -----
+ subjectTriplets
+ 	"Answer a list of triplets characterizing the subjects in the current taxonomy."
+ 
+ 	^ SubjectTriplets ifNil: [
+ 		SubjectTriplets := (self cachedTripletsFor: #subject)
+ 			ifNil: [self defaultSubjectTriplets]]!

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>tripletsFileNameFor: (in category '*Etoys-Squeakland-classification information') -----
+ tripletsFileNameFor: aCategory
+ 	"self tripletsFileNameFor: #age"
+ 
+ 	^ '.', aCategory, 'CatList-', Locale current localeID printString, '.csv'
+ !

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>tripletsFrom: (in category '*Etoys-Squeakland-classification information') -----
+ tripletsFrom: csvString
+ 	| result |
+ 	[result := (self linesIn: (csvString copyReplaceAll: String lf with: String cr))
+ 		collect: [:l | self csvLineQuotedDecodedFor: l]
+ 	] on: Error do: [:ex | ^ nil].
+ 	(self validateCategoryTriplets: result) ifFalse:  [^ nil].
+ 	^result.
+ !

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>tripletsUrlFor: (in category '*Etoys-Squeakland-classification information') -----
+ tripletsUrlFor: aCategory
+ 	"self tripletsUrlFor: #age"
+ 
+ 	^'http://squeakland.org/', aCategory, 'CatList?lang=', Locale current localeID printString!

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>updateTripletsFor: (in category '*Etoys-Squeakland-classification information') -----
+ updateTripletsFor: aCategory
+ 	"Fetch the age-range, subject, or region triplet files from the web site and cache them locally."
+ 
+ 	| contents triplets file filename |
+ 	contents := (HTTPSocket httpGet: (self tripletsUrlFor: aCategory) args: #() user: '' passwd: '') contents.
+ 	triplets := self tripletsFrom: contents.
+ 	triplets ifNotNil: [
+ 		self useTriplets: triplets for: aCategory.
+ 		filename := self tripletsFileNameFor: aCategory.
+ 		file := FileStream fileNamed: filename.
+ 		[file truncate; nextPutAll: contents] ensure: [file close].
+ 	].
+ 	!

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>updateTripletsFromWebSite (in category '*Etoys-Squeakland-classification information') -----
+ updateTripletsFromWebSite
+ 	"Attempt to update the age-range, subject, and region triplets cache on file by looking for the latest versions on the web site."
+ 
+ 	#(age subject region) do: [:cat |
+ 		self updateTripletsFor: cat]!

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>updateTripletsFromWebSiteInBackground (in category '*Etoys-Squeakland-classification information') -----
+ updateTripletsFromWebSiteInBackground
+ 	[
+ 		[self updateTripletsFromWebSite] ifError: []
+ 	] forkAt: Processor userBackgroundPriority named: 'Etoys category updater'!

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>useTriplets:for: (in category '*Etoys-Squeakland-classification accessing') -----
+ useTriplets: triplets for: aCategory
+ 	aCategory = #age ifTrue: [AgeTriplets := triplets].
+ 	aCategory = #subject ifTrue: [SubjectTriplets := triplets].
+ 	aCategory = #region ifTrue: [RegionTriplets := triplets].!

Item was added:
+ ----- Method: EToyProjectDetailsMorph class>>validateCategoryTriplets: (in category '*Etoys-Squeakland-classification information') -----
+ validateCategoryTriplets: aList
+ 	"The input is a tuple obtained by extracting lines from a string obtained from the squeakland web site.  Answer true if the tuple passes the smoke-test for category triplets."
+ 
+ 	
+ 	(aList isNil or: [aList size < 2]) ifTrue: [^ false].
+ 	aList do:
+ 		[:element |
+ 			(element isCollection not or:  [element size < 3]) ifTrue: [^ false]].
+ 	^ true
+ 
+ "
+ self validateCategoryTriplets:  RegionTriplets
+ "!

Item was added:
+ ----- Method: EToyProjectDetailsMorph>>choicesFor: (in category '*Etoys-Squeakland-utilities') -----
+ choicesFor: aSymbol
+ 	"Answer the list of choices to offer for the given symbol, which will be subject, age, or region.  Answer nil if the symbol provided is one without enumerated choices."
+ 	
+ 	aSymbol = #subject ifTrue:
+ 		[^ self class subjectTriplets].
+ 
+ 	aSymbol = #age ifTrue:
+ 		[^ self class ageTriplets].
+ 
+ 	aSymbol = #region ifTrue:
+ 		[^ self class regionTriplets].
+ 
+ 	^ nil!

Item was changed:
+ ----- Method: EToyProjectDetailsMorph>>copyOutDetails (in category 'project details') -----
- ----- Method: EToyProjectDetailsMorph>>copyOutDetails (in category 'as yet unclassified') -----
  copyOutDetails
+ 	"Prepare a new Dictionary holding project-info details as noted in the dialog."
  
+ 	| newDetails elements item user |
- 	| newDetails |
- 
  	newDetails := Dictionary new.
  	self fieldToDetailsMappings do: [ :each |
  		namedFields at: each first ifPresent: [ :field |
+ 				(#('age' 'subject' 'region') includes: each first)
+ 					ifFalse:
+ 							[newDetails at: each second put: field contents string]
+ 						ifTrue:
+ 							[elements := self choicesFor: each first.  "triplet"
+ 							item := elements detect: [:el | el third = field contents string translated] ifNone: [nil].
+ 							item ifNotNil:
+ 								[newDetails at: each second put: item first]]]].
+ 
+ 
- 			newDetails at: each second put: field contents string
- 		].
- 	].
  	namedFields at: 'projectname' ifPresent: [ :field |
+ 		newDetails at: 'projectname' put: field contents string withBlanksTrimmed].
+ 
+ 	namedFields
+ 		at: 'author'
+ 		ifPresent: [:field | 
+ 			user := field contents string withBlanksTrimmed.
+ 			newDetails at: 'projectauthor' put: user.
+ 			user isEmpty
+ 				ifTrue: [user := nil].
+ 			theProject
+ 				ifNotNil: [theProject forgetExistingURL]].
+ 
+ 	^ newDetails!
- 		newDetails at: 'projectname' put: field contents string withBlanksTrimmed.
- 	].
- 	^newDetails!

Item was changed:
+ ----- Method: EToyProjectDetailsMorph>>doOK (in category 'utilities') -----
- ----- Method: EToyProjectDetailsMorph>>doOK (in category 'as yet unclassified') -----
  doOK
+ 	"User hit the ok button in the project-info dialog.  Store the updated project-info back in the project. Call the message-send residing in the receiver's actionBlock to carry out any subsequent desired task.  Note that this method sets the 'arguments' of the message-send in the actionBlock"
  
+ 	| args actionSelector  |
  	self validateTheProjectName ifFalse: [^false].
+ 	projectDetails := self copyOutDetails.
+ 
+ 	theProject acceptProjectDetails: projectDetails.  "Make sure project & world feel the changes"
+ 		
+ 	actionBlock isMessageSend "new way -- hopefully all cases"
+ 		ifTrue:  "please excuse this ugly, non-modular code..."
+ 			[actionSelector := actionBlock selector.
+ 			args := (actionSelector = #handUserSorterMorphForProjectNamed:) 
+ 				ifTrue:
+ 					[{theProject name}]
+ 				ifFalse:
+ 					[actionSelector numArgs = 0
+ 						ifTrue:
+ 							[nil]
+ 						ifFalse:
+ 							[Array with: projectDetails]].
+ 			actionBlock arguments: args.
+ 			actionBlock value]
+ 
+ 		ifFalse:  "Old way, with actionBlock actually a block of one argument.  This should no longer occur."
+ 			[actionBlock value: projectDetails].
+ 
+ 	self delete!
- 	actionBlock value: self copyOutDetails.
- 	self delete.!

Item was added:
+ ----- Method: EToyProjectDetailsMorph>>doPopUp:event:for: (in category '*Etoys-Squeakland-utilities') -----
+ doPopUp: aSymbol event: anEvent for: aTextMorph
+ 	"The user clicked on a pop-up field in the project-info dialog.  Put up the pop-up of choices."
+ 
+ 	| aMenu aTitle |
+ 	aMenu := MenuMorph new defaultTarget: self.
+ 	aTitle := aTextMorph valueOfProperty: #menuTitle.
+ 	aTitle ifNotNil:
+ 		[aMenu addTitle: aTitle translated].
+ 	aMenu add: '(none)' translated target: self selector: #setInfoField:to: argumentList: {aSymbol asString. '(none)'}.
+ 	aMenu addLine.
+ 	(self choicesFor: aSymbol) do:
+ 		[:aChoice |
+ 			aMenu add: aChoice third translated target: self selector: #setInfoField:to: argumentList: {aSymbol. aChoice first}].
+ 	aMenu popUpInWorld!

Item was changed:
+ ----- Method: EToyProjectDetailsMorph>>fieldToDetailsMappings (in category 'project details') -----
- ----- Method: EToyProjectDetailsMorph>>fieldToDetailsMappings (in category 'as yet unclassified') -----
  fieldToDetailsMappings
+ 	"Answer an array describing, top to bottom, the details of each element.
+ 		Each element is a tuple consisting of:
+ 			1.	field name (internal)
+ 			2.	key in the project-details dictionary
+ 			3.	text (english version) to be shown in the entry's label at left.
+ 			4. vertical space to allow
+ 			5. entry type: (if missing, text is implied)
+ 				#text --> editable text field
+ 				#popUp --> pop-up of choices"
+ 	^{
+ 		{#description. 'projectdescription'. 'Description' translatedNoop. 100}. 
+ 		{#author. 'projectauthor'. 'Author' translatedNoop. 20}.
+ 		{#keywords. 'projectkeywords'. 'Tags' translatedNoop. 20}.
+ 		"{#subject.  'projectcategory'.  'Subject' translatedNoop.  20.  #popUp}.
+ 		{#age.		'projectage'.	'Target Age' translatedNoop.  20.  #popUp}.
+ 		{#region.		'projectregion'.	'Region' translatedNoop.  20.  #popUp}.	"
  
+ 	}
- 	^#(
- 		(#description 'projectdescription' 'Description:' 100) 
- 		(#author 'projectauthor' 'Author:' 20) 
- 		(#category 'projectcategory' 'Category:' 20)
- 		(#subCategory 'projectsubcategory' 'Sub-category:' 20)
- 		(#keywords 'projectkeywords' 'Key words:' 20)
- 	)
  !

Item was changed:
+ ----- Method: EToyProjectDetailsMorph>>fillInDetails (in category 'project details') -----
- ----- Method: EToyProjectDetailsMorph>>fillInDetails (in category 'as yet unclassified') -----
  fillInDetails
+ 	"Given that the receiver's namedFields is already set up, give each such field its appropriate initial value."
  
+ 	| elements |
+ 	theProject ifNotNil:
+ 		[namedFields at: 'projectname' ifPresent:
+ 			[:field | field contentsWrapped: theProject name]].
+ 
+ 	projectDetails ifNotNil:
+ 		[self fieldToDetailsMappings do: [ :tuple |
+ 			namedFields at: tuple first ifPresent: [ :field |
+ 				projectDetails at: tuple second ifPresent: [ :data |
+ 					elements := self choicesFor: tuple first.
+ 					elements
+ 						ifNil:
+ 							[field contentsWrapped: data]
+ 						ifNotNil:
+ 							[| item |
+ 							item := elements detect: [:el | el first = data] ifNone: [nil].
+ 							item ifNotNil:
+ 								[field contentsWrapped: item third translated]
+ 							ifNil:
+ 								[field contentsWrapped: '(none)' translated]]]]].
+ 		"Compatibility with older projects"
+ 		projectDetails at: 'projectcategory' ifPresent: [:data |
+ 			((self choicesFor: #subject)
+ 				detect: [:el | el first = data]
+ 				ifNone: [nil])
+ 					ifNotNil: [:item |
+ 						namedFields
+ 							at: #keywords
+ 							ifPresent: [:field |
+ 								field contentsWrapped:
+ 									(item third translated,
+ 									', ',
+ 									field contents asString)]]]]!
- 	theProject ifNotNil: [
- 		namedFields at: 'projectname' ifPresent: [ :field |
- 			field contentsWrapped: theProject name
- 		].
- 	].
- 	projectDetails ifNotNil: [
- 		self fieldToDetailsMappings do: [ :each |
- 			namedFields at: each first ifPresent: [ :field |
- 				projectDetails at: each second ifPresent: [ :data |
- 					field contentsWrapped: data
- 				].
- 			].
- 		].
- 	].!

Item was added:
+ ----- Method: EToyProjectDetailsMorph>>popUpEntryNamed: (in category '*Etoys-Squeakland-utilities') -----
+ popUpEntryNamed: aString
+ 	"Answer a text morph that will serve as a pop-up"
+ 
+ 	| newField |
+ 	newField := StaticTextMorph new beAllFont: self myFont;
+ 				 extent: 400 @ 20;
+ 				 contentsWrapped: '(none)' translated.
+ 	namedFields at: aString put: newField.
+ 	newField on: #click send: #doPopUp:event:for: to: self withValue: aString.
+ 	^ newField!

Item was added:
+ ----- Method: EToyProjectDetailsMorph>>popUpEntryNamed:menuTitle: (in category '*Etoys-Squeakland-utilities') -----
+ popUpEntryNamed: aString menuTitle: titleInEnglish
+ 	"Answer a text morph that will serve as a pop-up.  The first parameter is the key in the named-fields dictionary, the second is the title (in english) to give to the menu."
+ 
+ 	| newField |
+ 	newField := StaticTextMorph new beAllFont: self myFont;
+ 				 extent: 400 @ 20;
+ 				 contentsWrapped: '(none)' translated.
+ 	newField setProperty: #menuTitle toValue: titleInEnglish.
+ 	namedFields at: aString put: newField.
+ 	newField on: #click send: #doPopUp:event:for: to: self withValue: aString.
+ 	^ newField!

Item was changed:
  ----- Method: EToyProjectDetailsMorph>>rebuild (in category 'initialization') -----
  rebuild
+ 	"Rebuild the receiver from scratch."
  
+ 	| bottomButtons header toAdd |
- 	| bottomButtons |
- 
  	self removeAllMorphs.
+ 	header := self addARow: {
+ 		self lockedString: 'Please describe this project' translated.
- 
- 	self addARow: {
- 		self
- 			lockedString: 'Please describe this project' translated
- 			font: Preferences standardEToysTitleFont.
  	}.
+ 	header color: ScriptingSystem baseColor.
- 
- 	self addARow: {self space }.
- 
  	self addARow: {
+ 		self lockedString: 'Project Name' translated.
- 		self rightLockedString: 'Name:' translated.
  		self inAColumnForText: {self fieldForProjectName}
  	}.
- 
  	self expandedFormat ifTrue: [
  		self fieldToDetailsMappings do: [ :each |
+ 			toAdd := (each size < 5 or: [each fifth = #text])
+ 				ifTrue:
+ 					[self genericTextFieldNamed: each first]
+ 				ifFalse:
+ 					[self popUpEntryNamed: each first menuTitle: each third].
+ 
  			self addARow: {
+ 				self lockedString: each third translated.
+ 				self inAColumnForText: {toAdd height: each fourth}
- 				self rightLockedString: each third translated.
- 				self inAColumnForText: {(self genericTextFieldNamed: each first) height: each fourth}
  			}.
  		].
  	].
+ 	bottomButtons _ self expandedFormat ifTrue: [
+ 		{
+ 			self okButton.
+ 			self cancelButton.
+ 		}
+ 	] ifFalse: [
+ 		{
+ 			self okButton.
+ 			self expandButton.
+ 			self cancelButton.
+ 		}
+ 	].
- 	self addARow: {self space }.
- 
- 	bottomButtons := self expandedFormat
- 		ifTrue: [ { self okButton. self cancelButton } ]
- 		ifFalse: [ { self okButton. self expandButton. self cancelButton } ].
  	self addARow: bottomButtons.
- 
  	self fillInDetails.!

Item was added:
+ ----- Method: EToyProjectDetailsMorph>>setInfoField:to: (in category '*Etoys-Squeakland-utilities') -----
+ setInfoField: aFieldName to: aValue
+ 	"Install a value into an info field of the dialog.  Textual fields are filled literally, but enumerated fields (subject, region, etc.) are represented by codes which get mapped into (translated) text to display."
+ 
+ 	| newValue choices |
+ 	newValue := aValue.
+ 
+ 	choices := self choicesFor: aFieldName.
+ 	choices ifNotNil:  "i.e. one of the fields with enumerated values"
+ 		[(choices detect: [:c | c first = aValue] ifNone: [nil]) ifNotNilDo:
+ 			[:item | newValue := item third translated]].
+ 
+ 	(namedFields at: aFieldName) contentsWrapped: newValue
+ 	!

Item was changed:
  ----- Method: EToyProjectHistoryMorph class>>descriptionForPartsBin (in category 'parts bin') -----
  descriptionForPartsBin
+ 	^ self partName: 	'ProjectHistory' translatedNoop
+ 		categories:		#()
+ 		documentation:	'A tool that lets you navigate back to recently-visited projects' translatedNoop!
- 	^ self partName: 	'ProjectHistory'
- 		categories:		#('Navigation')
- 		documentation:	'A tool that lets you navigate back to recently-visited projects'!

Item was changed:
  ----- Method: EToyProjectHistoryMorph>>closeMyFlapIfAny (in category 'as yet unclassified') -----
  closeMyFlapIfAny
  
  	| myFlap allTabs myTab myWorld |
  
  	myWorld := self world.
  	myFlap := self nearestOwnerThat: [ :each | each isFlap].
+ 	myFlap ifNil: [
+ 		self delete.
+ 		^self].
- 	myFlap ifNil: [^self].
  	allTabs := myWorld submorphs select: [ :each | each isFlapTab].
  	myTab := allTabs detect: [ :each | each referent == myFlap] ifNone: [^self].
  	myTab hideFlap.
  	self refreshWorld.
  	
  !

Item was changed:
  ----- Method: EToyProjectHistoryMorph>>jumpToProject (in category 'as yet unclassified') -----
  jumpToProject
  
  	| selection |
+ 	selection := (Project current buildJumpToMenu: MenuMorph new) invokeModal.
- 	selection := (Project current buildJumpToMenu: MenuMorph new) startUp.
  	self closeMyFlapIfAny.
  	Project current jumpToSelection: selection
  !

Item was changed:
+ ----- Method: EToyProjectQueryMorph class>>onServer: (in category 'instance creation') -----
- ----- Method: EToyProjectQueryMorph class>>onServer: (in category 'as yet unclassified') -----
  onServer: aProjectServer
  	"EToyProjectQueryMorph onServer: SuperSwikiServer testOnlySuperSwiki"
  
+ 	| detailsMorph messageToSendIfValid |
- 	
  
+ 	detailsMorph := self basicNew.
+ 
+ 	messageToSendIfValid := MessageSend receiver: detailsMorph selector: #carryOutQuery:onProjectServer: arguments: {nil. aProjectServer}.
+ 
+ 	detailsMorph
- 	(self basicNew)
  		project: nil
+ 		actionBlock: messageToSendIfValid;
+ 
+ "***		actionBlock: [ :x | 
+ 			criteria _ OrderedCollection new.
+ 			x keysAndValuesDo: [ :k :v |
+ 				(clean _ v withBlanksTrimmed convertToEncoding: SuperSwikiServer defaultEncodingName) isEmpty
- 		actionBlock: [ :x | | criteria | 
- 			criteria := OrderedCollection new.
- 			x keysAndValuesDo: [ :k :v | | clean |
- 				(clean := v withBlanksTrimmed) isEmpty
  					ifFalse: [criteria add: k,': *',clean,'*']].
+ 			aProjectServer queryProjectsAndShow: criteria];  ****"
- 			aProjectServer queryProjectsAndShow: criteria];
  
  		initialize;
  		becomeModal;
  		openCenteredInWorld!

Item was added:
+ ----- Method: EToyProjectQueryMorph>>carryOutQuery:onProjectServer: (in category '*Etoys-Squeakland-query') -----
+ carryOutQuery: details onProjectServer: aProjectServer
+ 	"The user submitted a query; the parameter holds the details dictionary.  Carry out the query."
+ 
+ 	| criteria clean |
+ 	criteria := OrderedCollection new.
+ 	details keysAndValuesDo:
+ 		[ :k :v |
+ 			(clean _ v withBlanksTrimmed convertToEncoding: SuperSwikiServer defaultEncodingName) isEmpty
+ 						ifFalse: [criteria add: k,': *',clean,'*']].
+ 	aProjectServer queryProjectsAndShow: criteria!

Item was changed:
+ ----- Method: EToyProjectQueryMorph>>doOK (in category 'ok button hit') -----
- ----- Method: EToyProjectQueryMorph>>doOK (in category 'as yet unclassified') -----
  doOK
+ 	"User hit the ok button in the project-query dialog."
  
+ 	| details |
+ 	details := self copyOutDetails.
+ 
+ 	actionBlock isMessageSend "new way -- hopefully all cases"
+ 		ifTrue:
+ 			[actionBlock arguments: {details. actionBlock arguments second}.
+ 			actionBlock value]
+ 
+ 		ifFalse:  "Old way, with actionBlock actually a block of one argument.  This should no longer occur."
+ 			[actionBlock value: details].
+ 
+ 	self delete!
- 	actionBlock value: self copyOutDetails.
- 	self delete.!

Item was changed:
+ ----- Method: EToyProjectQueryMorph>>rebuild (in category 'utilities') -----
- ----- Method: EToyProjectQueryMorph>>rebuild (in category 'as yet unclassified') -----
  rebuild
+ 	"Rebuild the receiver from scratch."
  
+ 	| toAdd isText |
  	self removeAllMorphs.
  	self addARow: {
+ 		self lockedString: 'Enter things to search for' translated.
- 		self lockedString: 'Enter things to search for'.
  	}.
  	self addARow: {
+ 		self lockedString: 'Project Name' translated.
- 		self lockedString: 'Name:'.
  		self inAColumnForText: {self fieldForProjectName}
  	}.
  	self fieldToDetailsMappings do: [ :each |
+ 		isText := each size < 5 or: [each fifth = #text].
  		self addARow: {
+ 			self lockedString: each third translated.
+ 				toAdd := isText
+ 					ifTrue:
+ 						[self genericTextFieldNamed: each first]
+ 					ifFalse:
+ 						[self popUpEntryNamed: each first menuTitle: each third].
+ 
+ 				self inAColumnForText: {toAdd height: each fourth}
+ 
- 			self lockedString: each third.
- 			self inAColumnForText: {(self genericTextFieldNamed: each first) height: each fourth}
  		}.
  	].
  
  	self addARow: {
  		self okButton.
  		self cancelButton.
  	}.
  	self fillInDetails.!

Item was changed:
  ----- Method: EToyProjectRenamerMorph>>cancelButton (in category 'as yet unclassified') -----
  cancelButton
+ 
+ 	^self
+ 		buttonNamed: 'Cancel' translated
+ 		action: #doCancel 
+ 		color: self buttonColor 
+ 		help: 'Cancel this Publish operation.' translated!
- 	^ self
- 		buttonNamed: 'Cancel'
- 		action: #doCancel
- 		color: ColorTheme current cancelColor
- 		help: 'Cancel this Publish operation.'!

Item was changed:
  ----- Method: EToyProjectRenamerMorph>>defaultColor (in category 'initialization') -----
  defaultColor
  	"answer the default color/fill style for the receiver"
+ 	^ ScriptingSystem paneColor!
- 	^ ColorTheme current dialogColor!

Item was changed:
+ ----- Method: EToyProjectRenamerMorph>>doOK (in category 'ok button pressed') -----
- ----- Method: EToyProjectRenamerMorph>>doOK (in category 'as yet unclassified') -----
  doOK
+ 	"The user hit the ok button in the renamer dialog box; carry out the rename."
  
+ 	| aName |
  	self validateTheProjectName ifFalse: [^self].
+ 	aName := (namedFields at: 'projectname') contents string withBlanksTrimmed.
  	self delete.
+ 	actionBlock isMessageSend
+ 		ifTrue:
+ 			[actionBlock arguments: (Array with: aName).
+ 			actionBlock value]
+ 		ifFalse:
+ 			[actionBlock value: aName]!
- 	actionBlock value: (namedFields at: 'projectname') contents string withBlanksTrimmed.!

Item was changed:
  ----- Method: EToyProjectRenamerMorph>>initialize (in category 'initialization') -----
  initialize
  	"initialize the state of the receiver"
  	super initialize.
  	""
  	self vResizing: #shrinkWrap;
+ 	  hResizing: #shrinkWrap;
+ 	  layoutInset: 3;
+ 	  cellInset: 3;
+ 	  useRoundedCornersInEtoys;
+ 	  rebuild!
- 		 hResizing: #shrinkWrap;
- 		 layoutInset: 4;
- 		 useRoundedCorners;
- 		 rebuild!

Item was changed:
  ----- Method: EToyProjectRenamerMorph>>okButton (in category 'as yet unclassified') -----
  okButton
+ 
+ 	^self
+ 		buttonNamed: 'OK' translated
+ 		action: #doOK 
+ 		color: self buttonColor 
+ 		help: 'Change my name and continue publishing.' translated!
- 	^ self
- 		buttonNamed: 'OK'
- 		action: #doOK
- 		color: ColorTheme current okColor
- 		help: 'Change my name and continue publishing.'!

Item was added:
+ ----- Method: EToySenderMorph>>hideField: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ hideField: aFieldName
+ 	fields at: aFieldName ifPresent: [:m |
+ 		[m owner notNil and: [m owner submorphs size =1]]
+ 			whileTrue: [m := m owner].
+ 		m delete]!

Item was added:
+ ----- Method: EToyVocabulary class>>allPhrasesWithContextToTranslate (in category '*Etoys-Squeakland-as yet unclassified') -----
+ allPhrasesWithContextToTranslate
+ 	| etoyVocab results literals additions |
+ 
+ 	results := OrderedCollection new.
+ 	etoyVocab := Vocabulary eToyVocabulary.
+ 	etoyVocab initialize.		"just to make sure that it's unfiltered."
+ 	self morphClassesDeclaringViewerAdditions do: [:cl |
+ 		(cl class includesSelector: #additionsToViewerCategories)
+ 			ifTrue: [
+ 				literals := OrderedCollection new.
+ 				cl additionsToViewerCategories do: [:group | 
+ 					literals add: group first.
+ 					group second do: [:tuple |
+ 						literals add: (ScriptingSystem wordingForOperator: (tuple at: 2)).  "wording"
+ 						literals add: (tuple at: 3).  "help string"]].
+ 				literals ifNotEmpty: [
+ 					results add: {cl category. cl class. #additionsToViewerCategories. literals}]].
+ 
+ 		cl class selectors do: [:aSelector | ((aSelector beginsWith: 'additionsToViewerCategory')
+ 								and: [(aSelector at: 26 ifAbsent: []) ~= $:])
+ 			ifTrue: [
+ 				literals := OrderedCollection new.
+ 				additions := (cl perform: aSelector).
+ 				literals add: additions first.
+ 				additions second do: [:tuple |
+ 					literals add: (ScriptingSystem wordingForOperator: (tuple at: 2)).  "wording"
+ 					literals add: (tuple at: 3).  "help string"].
+ 				literals ifNotEmpty: [
+ 					results add: {cl category. cl class. aSelector. literals}]]]].
+ 
+ 		literals :=( self allStandardVocabularies
+ 			select: 
+ 				[:aVocab | aVocab representsAType]
+ 			thenCollect: 
+ 				[:aVocab | aVocab vocabularyName asString ]).
+ 		results add: {Vocabulary class category. Vocabulary class. #typeChoices. literals}.
+ 	^results.!

Item was changed:
  ----- Method: EToyVocabulary class>>masterOrderingOfCategorySymbols (in category 'accessing') -----
  masterOrderingOfCategorySymbols
  	"Answer a dictatorially-imposed presentation list of category symbols.
  	This governs the order in which available vocabulary categories are presented in etoy viewers using the etoy vocabulary.
  	The default implementation is that any items that are in this list will occur first, in the order specified here; after that, all other items will come, in alphabetic order by their translated wording."
  
+ 	EToyVocabulary class decompile:  #masterOrderingOfCategorySymbols.
+ 	self flag: #(('scripts' translatedNoop) ('variables' translatedNoop) ('as object' translatedNoop)).
+ 
+ 	^ {'basic' translatedNoop. 'color' translatedNoop. 'geometry' translatedNoop. 
+ 		'more geometry' translatedNoop.
+ 		'pen use' translatedNoop. 'tests' translatedNoop. 'motion' translatedNoop. 'fill & border' translatedNoop. 'scripting' translatedNoop. 'sound' translatedNoop. 'observation' translatedNoop. 'button' translatedNoop. 'layout' translatedNoop. 'drag & drop' translatedNoop. 'search' translatedNoop. 'miscellaneous' translatedNoop}
+ 		collect: [:each | each asSymbol]!
- 	^#(basic #'color & border' geometry motion #'pen use' tests layout #'drag & drop' scripting observation button search miscellaneous)!

Item was added:
+ ----- Method: EToyVocabulary>>systemSlotNames (in category '*Etoys-Squeakland-initialization') -----
+ systemSlotNames
+ 	"Answer a list of the predefined system slots"
+ 
+ 	^ (methodInterfaces select: [:m | m resultType ~= #unknown] thenCollect: [:m | m selector inherentSelector]) keys
+ 
+ "
+ Vocabulary eToyVocabulary systemSlotNames
+ "!

Item was added:
+ ----- Method: EncodedCharSet class>>scanSelector (in category '*Etoys-Squeakland-accessing - displaying') -----
+ scanSelector
+ 	^ #scanMultiCharactersFrom:to:in:rightX:stopConditions:kern:!

Item was added:
+ ----- Method: EncodedCharSet class>>scanSelectorAt: (in category '*Etoys-Squeakland-accessing - displaying') -----
+ scanSelectorAt: encoding 
+ 	| charset |
+ 	charset := self charsetAt: encoding.
+ 	^ charset
+ 		ifNil: [LanguageEnvironment scanSelector]
+ 		ifNotNil: [charset scanSelector]!

Item was added:
+ ----- Method: Encoder>>requestor: (in category '*Etoys-Squeakland-error handling') -----
+ requestor: req
+ 	"Often the requestor is a BrowserCodeController"
+ 	requestor _ req!

Item was added:
+ AlignmentMorphBob1 subclass: #EtoyDAVLoginMorph
+ 	instanceVariableNames: 'theName theNameMorph thePassword thePasswordMorph actionBlock cancelBlock panel'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Experimental'!

Item was added:
+ ----- Method: EtoyDAVLoginMorph class>>loginAndDo:ifCanceled: (in category 'instance creation') -----
+ loginAndDo: aBlock ifCanceled: cancelBlock
+ 	"EtoyDAVLoginMorph loginAndDo:[:n :p | true] ifCanceled:[]"
+ 	| |
+ 	self new loginAndDo: aBlock ifCanceled: cancelBlock.
+ !

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>buildPanel (in category 'private') -----
+ buildPanel
+ 
+ 	| title |
+ 	self deletePanel.
+ 	panel := AlignmentMorphBob1 new.
+ 	panel vResizing: #shrinkWrap;
+ 		 hResizing: #shrinkWrap;
+ 		 layoutInset: 4;
+ 		color: self defaultColor;
+ 		 beSticky;
+ 		borderWidth: self defaultBorderWidth;
+ 		borderColor:  self defaultBorderColor.
+ 	title := TextMorph new contents: 'Etoys is trying to open your web browser.\If it does not work, you can sign up at:\\' translated withCRs, self url; beAllFont: self myFont.
+ 	title beSticky.
+ 	title centered.
+ 	panel addARow: {title}.
+ 	panel addARow: { (StringMorph contents:'') lock }.
+ 
+ 	panel addARow: {
+ 		self newSpacer: Color transparent.
+ 		self okButton2 hResizing: #rigid.
+ 		self newSpacer: Color transparent.
+ 	}.
+ 	panel setProperty: #morphicLayerNumber toValue: 9.
+ 	^ panel.
+ 
+ !

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>buttonColor (in category 'building') -----
+ buttonColor
+ 	^ self defaultColor!

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>buttonNamed:action:color:help: (in category 'building') -----
+ buttonNamed: aString action: aSymbol color: aColor help: helpString
+ 
+ 	| f col |
+ 	f _ SimpleButtonMorph new
+ 		target: self;
+ 		label: aString font: self myFont;
+ 		color: aColor;
+ 		actionSelector: aSymbol;
+ 		setBalloonText: helpString.
+ 	col _ (self inAColumn: {f}) hResizing: #spaceFill.
+ 	^col!

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>cancelButton (in category 'building') -----
+ cancelButton
+ 
+ 	^self
+ 		buttonNamed: 'Cancel' translated
+ 		action: #doCancel 
+ 		color: self buttonColor 
+ 		help: 'Cancel this login operation.' translated!

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>defaultBorderColor (in category 'initialization') -----
+ defaultBorderColor
+ 	"answer the default border color/fill style for the receiver"
+ 	^ Color fromString: '#ECE8CC'!

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ 	"answer the default border width for the receiver"
+ 	^ 8!

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 
+ 	^ (Color fromString: '#ECE8CC') muchLighter!

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>delete (in category 'initialize') -----
+ delete
+ 
+ 	self deletePanel.
+ 	super delete.
+ !

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>deletePanel (in category 'private') -----
+ deletePanel
+ 
+ 	panel ifNotNil: [panel delete. panel := nil].!

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>doCancel (in category 'actions') -----
+ doCancel
+ 
+ 	self delete.
+ 	cancelBlock ifNotNil:[cancelBlock value].!

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>doOK (in category 'actions') -----
+ doOK
+ 
+ 	| proposed proposedPass |
+ 
+ 	proposed _ theNameMorph contents string.
+ 	proposed isEmpty ifTrue: [^self inform: 'Please enter your login name' translated].
+ 	proposed size > 24 ifTrue: [^self inform: 'Please make the name 24 characters or less' translated].
+ 	(Project isBadNameForStoring: proposed) ifTrue: [
+ 		^self inform: 'Please remove any funny characters' translated
+ 	].
+ 	proposedPass := thePasswordMorph contents string.
+ 	(actionBlock value: proposed value: proposedPass) ifTrue:[self delete].!

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	
+ 	super initialize.
+ 	""
+ 	self vResizing: #shrinkWrap;
+ 		 hResizing: #shrinkWrap;
+ 		 layoutInset: 4;
+ 		 beSticky;
+ 		 rebuild.
+ 	self setProperty: #morphicLayerNumber toValue: 10.!

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>launchBrowser (in category 'actions') -----
+ launchBrowser
+ 
+ 	ActiveWorld addMorph: self buildPanel centeredNear: Sensor cursorPoint.
+ 	ScratchPlugin primOpenURL: self url.
+ !

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>loginAndDo:ifCanceled: (in category 'private') -----
+ loginAndDo: aBlock ifCanceled: cb
+ 	"EtoyDAVLoginMorph loginAndDo:[:n :p | true] ifCanceled:[]"
+ 	self name: '' actionBlock: aBlock cancelBlock: cb;
+ 		fullBounds;
+ 		position: Display extent - self extent // 2.
+ 	self position: self position + (0 at 40).
+ 	ActiveWorld addMorphInLayer: self!

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>myFont (in category 'building') -----
+ myFont
+ 
+ 	^ Preferences standardEToysFont!

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>name:actionBlock:cancelBlock: (in category 'initialize') -----
+ name: aString actionBlock: aBlock cancelBlock: altBlock
+ 
+ 	theName _ aString.
+ 	actionBlock _ aBlock.
+ 	cancelBlock _ altBlock.
+ 	theNameMorph contentsWrapped: theName.
+ 	theNameMorph editor selectAll.!

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>newSpacer: (in category 'private') -----
+ newSpacer: aColor
+ 	"Answer a space-filling instance of me of the given color."
+ 
+ 	^ AlignmentMorph newSpacer: aColor
+ !

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>okButton (in category 'building') -----
+ okButton
+ 
+ 	^self
+ 		buttonNamed: 'OK' translated
+ 		action: #doOK 
+ 		color: self buttonColor 
+ 		help: 'Login to Squeakland' translated!

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>okButton2 (in category 'building') -----
+ okButton2
+ 
+ 	^self
+ 		buttonNamed: 'OK'  translated
+ 		action: #deletePanel 
+ 		color: self buttonColor 
+ 		help: 'Close this dialog' translated!

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>openInWorld: (in category 'initialization') -----
+ openInWorld: aWorld
+ 	super openInWorld: aWorld.
+ 	aWorld primaryHand newKeyboardFocus: theNameMorph.!

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>rebuild (in category 'initialize') -----
+ rebuild
+ 
+ 	| title link |
+ 	self removeAllMorphs.
+ 	title := StringMorph contents: 'Login to Squeakland' translated font: self myFont.
+ 	title lock.
+ 	link :=  StringMorph contents: '(create account)' translated font: Preferences standardListFont emphasis: 4.
+ 	link color: Color blue.
+ 	link beSticky.
+ 	link on: #click send: #launchBrowser to: self.
+ 	self addARow: { title. self newSpacer: Color transparent. link}.
+ 	self addARow: { (StringMorph contents:'') lock }.
+ 	(self addARow: {
+ 		(StringMorph contents: 'Username:' translated font: self myFont) lock.
+ 		Morph new extent: 15 at 0; color: Color transparent.
+ 		self newSpacer: Color transparent.
+ 		(theNameMorph _ TextMorph new
+ 			beAllFont: self myFont;
+ 			crAction: (MessageSend receiver: self selector: #doOK);
+ 			extent: 250 at 20;
+ 			borderStyle: (InsetBorder new color: Color black; width: 2);
+ 			contentsWrapped: 'the old name'
+ 			).
+ 	}) color: self defaultColor; borderWidth: 0.
+ 
+ 	self addARow: { (StringMorph contents:'') lock }.
+ 
+ 	(self addARow: {
+ 		(StringMorph contents: 'Password:' translated font: self myFont) lock.
+ 		Morph new extent: 15 at 0; color: Color transparent.
+ 		self newSpacer: Color transparent.
+ 		(thePasswordMorph _ TextMorph new
+ 			beAllFont: (FixedFaceFont new passwordFont baseFont: self myFont copy);
+ 			crAction: (MessageSend receiver: self selector: #doOK);
+ 			extent: 250 at 20;
+ 			borderStyle: (InsetBorder new color: Color black; width: 2);
+ 			contentsWrapped: ''
+ 			).
+ 	}) color: self defaultColor.
+ 
+ 	self addARow: { (StringMorph contents:'') lock }.
+ 
+ 	self addARow: {
+ 		self newSpacer: Color transparent.
+ 		self okButton hResizing: #rigid.
+ 		Morph new extent: 30 at 0; color: Color transparent.
+ 		self cancelButton hResizing: #rigid.
+ 	}.
+ !

Item was added:
+ ----- Method: EtoyDAVLoginMorph>>url (in category 'private') -----
+ url
+ 
+ 	^ 'http://squeakland.org/action/signup'.!

Item was changed:
  ----- Method: EtoyUpdatingThreePhaseButtonMorph class>>checkBox (in category 'instance creation') -----
  checkBox
  	"Answer a button pre-initialized with checkbox images."
  
  	"(Form extent: 12 at 12 depth: 32) morphEdit"
  	CheckedForm ifNil: [
+ 		self setForms: 24
- 		self setForms
  	].
  	^self new
  		onImage: CheckedForm;
  		pressedImage: MouseDownForm;
  		offImage: UncheckedForm;
  		extent: CheckedForm extent;
  		yourself
  !

Item was added:
+ ----- Method: EtoyUpdatingThreePhaseButtonMorph class>>setForms: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ setForms: size
+ 
+ 	| c |
+ 	UncheckedForm _ Form extent: size at size depth: 16.
+ 	c _ UncheckedForm getCanvas asBalloonCanvas.
+ 	c frameRectangle: UncheckedForm boundingBox width: (size // 12) color: Color black.
+ 	MouseDownForm _ UncheckedForm deepCopy.
+ 
+ 	CheckedForm _ UncheckedForm deepCopy.
+ 	c _ CheckedForm getCanvas asBalloonCanvas.
+ 	c
+ 		line: ((size*0.2)@(size*0.5)) asIntegerPoint
+ 		to: ((size*0.4)@(size*0.7)) asIntegerPoint
+ 		width: 2
+ 		color: Color gray darker.
+ 	c line: ((size*0.4)@(size*0.7)) asIntegerPoint
+ 		to: ((size*0.9)@(size*0.2)) asIntegerPoint
+ 		width: 2
+ 		color: Color gray darker.
+ !

Item was added:
+ Object subclass: #EtoysDebugger
+ 	instanceVariableNames: 'scriptEditor next timesToRepeat highlighter startingPosition'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Debugger'!

Item was added:
+ ----- Method: EtoysDebugger class>>initialize (in category 'class initialization') -----
+ initialize
+ "
+ 	self initialize
+ "
+ | buttonForm buttonPressedForm |
+ buttonForm := (Form
+ 	extent: 30 at 30
+ 	depth: 16
+ 	fromArray: #( 0 0 0 0 0 26425 1731815225 1731815225 1731815225 1731788800 0 0 0 0 0 0 0 0 0 1731815225 1731821567 2147450879 2147450879 2147450879 2147444537 1731815225 0 0 0 0 0 0 0 26425 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 1731788800 0 0 0 0 0 26425 1731821567 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147444537 1731788800 0 0 0 0 1731821567 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147444537 0 0 0 26425 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 1731788800 0 0 26425 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 1731788800 0 0 1731821567 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147444537 0 26425 2147450879 2147450879 2147450879 2147450879 2147418113 98303 2147418113 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 1731788800 26425 2147450879 2147450879 2147450879 2147450879 2147418113 98303 2147418113 98303 2147450879 2147450879 2147450879 2147450879 2147450879 1731788800 26425 2147450879 2147450879 2147450879 2147450879 2147418113 98303 2147418113 65537 2147450879 2147450879 2147450879 2147450879 2147450879 1731788800 1731821567 2147450879 2147450879 2147450879 2147450879 2147418113 98303 2147418113 65537 98303 2147450879 2147450879 2147450879 2147450879 2147444537 1731821567 2147450879 2147450879 2147450879 2147450879 2147418113 98303 2147418113 65537 65537 2147450879 2147450879 2147450879 2147450879 2147444537 1731821567 2147450879 2147450879 2147450879 2147450879 2147418113 98303 2147418113 65537 65537 98303 2147450879 2147450879 2147450879 2147444537 1731821567 2147450879 2147450879 2147450879 2147450879 2147418113 98303 2147418113 65537 65537 65537 2147450879 2147450879 2147450879 2147444537 1731821567 2147450879 2147450879 2147450879 2147450879 2147418113 98303 2147418113 65537 65537 98303 2147450879 2147450879 2147450879 2147444537 1731821567 2147450879 2147450879 2147450879 2147450879 2147418113 98303 2147418113 65537 65537 2147450879 2147450879 2147450879 2147450879 2147444537 1731821567 2147450879 2147450879 2147450879 2147450879 2147418113 98303 2147418113 65537 98303 2147450879 2147450879 2147450879 2147450879 2147444537 1731821567 2147450879 2147450879 2147450879 2147450879 2147418113 98303 2147418113 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147444537 26425 2147450879 2147450879 2147450879 2147450879 2147418113 98303 2147418113 98303 2147450879 2147450879 2147450879 2147450879 2147450879 1731788800 26425 2147450879 2147450879 2147450879 2147450879 2147418113 98303 2147418113 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 1731788800 26425 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 1731788800 0 1731821567 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147444537 0 0 26425 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 1731788800 0 0 26425 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 1731788800 0 0 0 1731821567 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147444537 0 0 0 0 26425 1731821567 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147444537 1731788800 0 0 0 0 0 26425 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 1731788800 0 0 0 0 0 0 0 1731815225 1731821567 2147450879 2147450879 2147450879 2147444537 1731815225 0 0 0 0 0 0 0 0 0 26425 1731815225 1731815225 1731815225 1731788800 0 0 0 0 0)
+ 	offset: 0 at 0).
+ buttonPressedForm := (Form
+ 	extent: 30 at 30
+ 	depth: 16
+ 	fromArray: #( 0 0 0 0 0 19026 1246906962 1246906962 1246906962 1246887936 0 0 0 0 0 0 0 0 0 1246906962 1246911190 1523997398 1523997398 1523997398 1523993170 1246906962 0 0 0 0 0 0 0 19026 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1246887936 0 0 0 0 0 19026 1246911190 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523993170 1246887936 0 0 0 0 1246911190 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523993170 0 0 0 19026 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1246887936 0 0 19026 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1246887936 0 0 1246911190 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523993170 0 19026 1523997398 1523997398 1523997398 1523997398 1523974145 88790 1523974145 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1246887936 19026 1523997398 1523997398 1523997398 1523997398 1523974145 88790 1523974145 88790 1523997398 1523997398 1523997398 1523997398 1523997398 1246887936 19026 1523997398 1523997398 1523997398 1523997398 1523974145 88790 1523974145 65537 1523997398 1523997398 1523997398 1523997398 1523997398 1246887936 1246911190 1523997398 1523997398 1523997398 1523997398 1523974145 88790 1523974145 65537 88790 1523997398 1523997398 1523997398 1523997398 1523993170 1246911190 1523997398 1523997398 1523997398 1523997398 1523974145 88790 1523974145 65537 65537 1523997398 1523997398 1523997398 1523997398 1523993170 1246911190 1523997398 1523997398 1523997398 1523997398 1523974145 88790 1523974145 65537 65537 88790 1523997398 1523997398 1523997398 1523993170 1246911190 1523997398 1523997398 1523997398 1523997398 1523974145 88790 1523974145 65537 65537 65537 1523997398 1523997398 1523997398 1523993170 1246911190 1523997398 1523997398 1523997398 1523997398 1523974145 88790 1523974145 65537 65537 88790 1523997398 1523997398 1523997398 1523993170 1246911190 1523997398 1523997398 1523997398 1523997398 1523974145 88790 1523974145 65537 65537 1523997398 1523997398 1523997398 1523997398 1523993170 1246911190 1523997398 1523997398 1523997398 1523997398 1523974145 88790 1523974145 65537 88790 1523997398 1523997398 1523997398 1523997398 1523993170 1246911190 1523997398 1523997398 1523997398 1523997398 1523974145 88790 1523974145 65537 1523997398 1523997398 1523997398 1523997398 1523997398 1523993170 19026 1523997398 1523997398 1523997398 1523997398 1523974145 88790 1523974145 88790 1523997398 1523997398 1523997398 1523997398 1523997398 1246887936 19026 1523997398 1523997398 1523997398 1523997398 1523974145 88790 1523974145 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1246887936 19026 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1246887936 0 1246911190 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523993170 0 0 19026 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1246887936 0 0 19026 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1246887936 0 0 0 1246911190 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523993170 0 0 0 0 19026 1246911190 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523993170 1246887936 0 0 0 0 0 19026 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1523997398 1246887936 0 0 0 0 0 0 0 1246906962 1246911190 1523997398 1523997398 1523997398 1523993170 1246906962 0 0 0 0 0 0 0 0 0 19026 1246906962 1246906962 1246906962 1246887936 0 0 0 0 0)
+ 	offset: 0 at 0).
+ ScriptingSystem saveForm: buttonForm atKey: #StepMe.
+ ScriptingSystem saveForm: buttonPressedForm atKey: #StepMePressed!

Item was added:
+ ----- Method: EtoysDebugger class>>on: (in category 'instance creation') -----
+ on: aScriptEditorMorph 
+ 	^ self basicNew initializeWith: aScriptEditorMorph!

Item was added:
+ ----- Method: EtoysDebugger>>delete (in category 'initialization') -----
+ delete
+ 	"If there is a highlighter associated with this debugger, delete it."
+ 
+ 	highlighter ifNotNil:
+ 		[:h | 
+ 			h stopStepping.
+ 			h delete]!

Item was added:
+ ----- Method: EtoysDebugger>>evaluateNextTile (in category 'evaluating') -----
+ evaluateNextTile
+ 	[next = (scriptEditor tiles at: 1 ifAbsent: [nil])
+ 		ifTrue: ["We are about to evaluate the first tile"
+ 			self updateStartingPosition].
+ 	self trailMorph batchPenTrails
+ 		ifTrue: [self evaluateNextTileWithBatchPenTrails]
+ 		ifFalse: [next evaluateOn: self]]
+ 		on: Error do: [:err || newNext |
+ 			newNext := scriptEditor tiles at: 1 ifAbsent: [^ self].
+ 			newNext = next
+ 				ifTrue: [err pass]
+ 				ifFalse: [next := newNext].
+ 			self evaluateNextTile]
+ 
+ !

Item was added:
+ ----- Method: EtoysDebugger>>evaluateNextTileWithBatchPenTrails (in category 'evaluating') -----
+ evaluateNextTileWithBatchPenTrails
+ 	| penDown |	
+ 	penDown := self scriptedPlayer getPenDown.
+ 	self scriptedPlayer setPenDown: false.
+ 	[next evaluateOn: self]
+ 		ensure: [self scriptedPlayer setPenDown: penDown].
+ 	(penDown and: [next = (scriptEditor tiles at: 1 ifAbsent: [nil])])
+ 		ifTrue: [| trailMorph tfm |
+ 			"We've just evaluated the last tile, we should draw pen trail"
+ 			trailMorph := self trailMorph.
+ 			tfm := self scriptedPlayer costume owner transformFrom: trailMorph.
+ 			trailMorph
+ 				drawPenTrailFor: self scriptedPlayer costume
+ 				from: (tfm localPointToGlobal: startingPosition)
+ 				to: (tfm localPointToGlobal: self scriptedPlayerPosition)]!

Item was added:
+ ----- Method: EtoysDebugger>>evaluatePhrase: (in category 'evaluating') -----
+ evaluatePhrase: tile
+ 	self highlight: tile.
+ 	tile try.
+ 	next := tile nextTile!

Item was added:
+ ----- Method: EtoysDebugger>>evaluateRepeat: (in category 'evaluating') -----
+ evaluateRepeat: tile
+ 	self highlight: tile numberOfTimesToRepeatPart;
+ 		timesToRepeat: tile calculateTimesToRepeat.
+ 	next := tile nextTile!

Item was added:
+ ----- Method: EtoysDebugger>>evaluateTest: (in category 'evaluating') -----
+ evaluateTest: test
+ 	| tile |
+ 	test testPart tiles isEmpty
+ 		ifTrue: [next := test yesPart tiles at: 1 ifAbsent: [test nextTile].
+ 			next = test 
+ 				ifTrue: [^ self]
+ 				ifFalse: [^ self evaluateNextTile]].
+ 	self highlight: test testPart.
+ 	tile := test evaluateTestPart
+ 		ifTrue: [test yesPart]
+ 		ifFalse: [test noPart].
+ 	next := tile tiles at: 1 ifAbsent: [test nextTile]!

Item was added:
+ ----- Method: EtoysDebugger>>highlight: (in category 'highlighting') -----
+ highlight: aMorph
+ 	"| rect |
+ 	rect := BorderedMorph newBounds: aMorph bounds color: Color transparent.
+ 	rect openInWorld.
+ 	World addAlarm: #delete
+ 		withArguments: #()
+ 		for: rect
+ 		at: (Time millisecondClockValue + 200)."
+ 	highlighter ifNotNil: [highlighter delete].
+ 	highlighter := HighlightMorph on: aMorph.
+ 	highlighter openInWorld!

Item was added:
+ ----- Method: EtoysDebugger>>initializeWith: (in category 'initialization') -----
+ initializeWith: aScriptEditorMorph
+ 	scriptEditor := aScriptEditorMorph.
+ 	next := scriptEditor tiles at: 1 ifAbsent: nil.
+ 	self updateStartingPosition;
+ 		initialize!

Item was added:
+ ----- Method: EtoysDebugger>>scriptedPlayer (in category 'accessing') -----
+ scriptedPlayer
+ 	^ scriptEditor playerScripted!

Item was added:
+ ----- Method: EtoysDebugger>>scriptedPlayerPosition (in category 'accessing') -----
+ scriptedPlayerPosition
+ 	^ self scriptedPlayer costume 
+ 		ifNil: [0 at 0] 
+ 		ifNotNil: [:m | m referencePosition]!

Item was added:
+ ----- Method: EtoysDebugger>>timesToRepeat (in category 'accessing') -----
+ timesToRepeat
+ 	^ timesToRepeat!

Item was added:
+ ----- Method: EtoysDebugger>>timesToRepeat: (in category 'accessing') -----
+ timesToRepeat: aNumber
+ 	timesToRepeat := aNumber!

Item was added:
+ ----- Method: EtoysDebugger>>trailMorph (in category 'accessing') -----
+ trailMorph
+ 	^ self scriptedPlayer costume ifNil: [World] ifNotNil: [:m | m trailMorph]!

Item was added:
+ ----- Method: EtoysDebugger>>updateStartingPosition (in category 'initialization') -----
+ updateStartingPosition
+ 	startingPosition := self scriptedPlayerPosition!

Item was added:
+ Error subclass: #EtoysError
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Exceptions Kernel'!

Item was added:
+ ----- Method: EtoysError>>defaultAction (in category 'all') -----
+ defaultAction
+ 	"See Error>>defaultAction for comments."
+ 
+ 	EtoysUnhandledError signalForException: self!

Item was added:
+ ----- Method: EtoysError>>description (in category 'all') -----
+ description
+ 	"Return a textual description of the exception."
+ 
+ 	| desc mt |
+ 	desc := self class name asString.
+ 	^(mt := self messageText) == nil
+ 		ifTrue: [desc]
+ 		ifFalse: [mt copyUpTo: $\]!

Item was added:
+ UnhandledError subclass: #EtoysUnhandledError
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Exceptions Kernel'!

Item was added:
+ ----- Method: EtoysUnhandledError>>devDefaultAction (in category 'priv handling') -----
+ devDefaultAction
+ 
+ 	Processor activeProcess
+ 		debug: exception signalerContext
+ 		title: exception description
+ 		full: false
+ 		contents: exception messageText
+ !

Item was added:
+ ----- Method: EventHandler>>allEventSelectorsHandled (in category '*Etoys-Squeakland-printing') -----
+ allEventSelectorsHandled
+ 	"For development use only... answer a list of all the event selectors for which the receiver has a non-nil selector poised for handling."
+ 
+ 	^ self allPossibleEventSelectors select: [:s | (self instVarNamed: s) notNil]!

Item was added:
+ ----- Method: EventHandler>>allPossibleEventRecipients (in category '*Etoys-Squeakland-printing') -----
+ allPossibleEventRecipients
+ 	"For development use only... answer a list of all the instance variables potentially representing event recipients.  Listed in alphabetical order."
+ 
+ 	^  #(clickRecipient doubleClickRecipient doubleClickTimeoutRecipient keyStrokeRecipient mouseDownRecipient mouseEnterDraggingRecipient mouseEnterRecipient mouseLeaveDraggingRecipient mouseLeaveRecipient mouseMoveRecipient mouseStillDownRecipient mouseUpRecipient startDragRecipient)!

Item was added:
+ ----- Method: EventHandler>>allPossibleEventSelectors (in category '*Etoys-Squeakland-printing') -----
+ allPossibleEventSelectors
+ 	"For development use only... answer a list of all the instance variables representing event selectors.  This does not imply that the receiver actually has non-nil values in them.  Listed in alphabetical order."
+ 
+ 	^ #(clickSelector doubleClickSelector doubleClickTimeoutSelector keyStrokeSelector mouseDownSelector mouseEnterDraggingSelector mouseEnterSelector mouseLeaveDraggingSelector mouseLeaveSelector mouseMoveSelector mouseStillDownSelector mouseUpSelector startDragSelector)!

Item was added:
+ RectangleMorph subclass: #EventMorph
+ 	instanceVariableNames: 'event'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !EventMorph commentStamp: 'sw 11/26/2006 03:09' prior: 0!
+ An abstract superclass for KeyboardEventMorph, MediaEventMorph, and MouseEventSequenceMorph.  These are morphs used on an EventRoll to represent events on an event tape. !

Item was added:
+ ----- Method: EventMorph>>brownDragConcluded (in category 'drag and drop') -----
+ brownDragConcluded
+ 	"After the user has manually repositioned the receiver via brown-halo-drag, this is invoked."
+ 
+ 	ActiveWorld abandonAllHalos.
+ 	self eventRoll ifNotNilDo:
+ 		[:evtRoll | evtRoll pushChangesBackToEventTheatre]!

Item was added:
+ ----- Method: EventMorph>>event: (in category 'accessing') -----
+ event: anObject
+ 	"Set the value of event."
+ 
+ 	event _ anObject!

Item was added:
+ ----- Method: EventMorph>>eventTheatre (in category 'accessing') -----
+ eventTheatre
+ 	"Answer the event-theatre associated with the receiver, nil if none.  This is only well-defined if the receiver resides within an EventRoll."
+ 
+ 	^ self eventRoll ifNotNil:
+ 		[self eventRoll eventTheatre]!

Item was added:
+ ----- Method: EventMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver."
+ 
+ 	super initialize.
+ 	self borderWidth: 0!

Item was added:
+ ----- Method: EventMorph>>justDroppedInto:event: (in category 'drag and drop') -----
+ justDroppedInto: aMorph event: anEvent
+ 	"The receiver was just dropped somewhere..."
+ 
+ 	| aFormerOwner |
+ 	aFormerOwner := self formerOwner ifNil: [^ self].
+ 	aMorph == aFormerOwner ifTrue: [^ self].
+ 	(aFormerOwner isKindOf: EventTimeline)
+ 		ifTrue:
+ 			[aFormerOwner eventRoll ifNotNilDo: [:r | r pushChangesBackToEventTheatre.
+ 			self formerOwner: nil] ].  "NB only do this once!!"!

Item was added:
+ ----- Method: EventMorph>>putEventsOnto: (in category 'event roll') -----
+ putEventsOnto: aStream
+ 	"Write all of the events represented by the receiver onto the given stream.  This generic implementation, usable by everything except the EventSequenceMorphs, puts a single event, one-for-one, onto the stream; the event differs from the receiver's own event in that its timeStamp is appropriately transformed."
+ 
+ 	| newEvent aTimeStamp |
+ 	newEvent := event veryDeepCopy.
+ 	aTimeStamp := self eventRoll timeStampForCurrentPositionOf: self.
+ 	newEvent timeStamp: aTimeStamp.
+ 	aStream nextPut: newEvent!

Item was added:
+ ----- Method: EventMorph>>suitableForDroppingIntoEventRoll (in category 'drag and drop') -----
+ suitableForDroppingIntoEventRoll
+ 	"Answer whether the receiver is suitable for dropping into an Event Roll."
+ 
+ 	^ true!

Item was added:
+ IconicButton subclass: #EventPlaybackButton
+ 	instanceVariableNames: 'caption contentArea tape autoStart autoDismiss initialPicture finalPicture'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !EventPlaybackButton commentStamp: 'sw 8/10/2007 13:33' prior: 0!
+ Obsolete -- the functionality of this class was subsumed in March 2007 by class PlaybackInvoker.
+ 
+ Class retained "temporarily" in support of pre-existing content.  Probably can now be gotten rid of...
+ 
+ 
+ Formerly:
+ 
+ A button which, when clicked, will open up an event-playback space, in which the user can play an event "movie".
+ 
+ caption - a String --the label beneath the button's icon.
+ 
+ contentArea - a Worldlet - a veryDeepCopy of the contentArea of the contributing MentoringEventRecorder at the time the recording was made.
+ 
+ tape  - an Array of MorphicEvent objects.
+ 
+ voiceRecorder - a copy of the voiceRecorder of the contributing MentoringEventRecorder.!

Item was added:
+ ----- Method: EventPlaybackButton>>addCustomMenuItems:hand: (in category 'menu ') -----
+ addCustomMenuItems: aCustomMenu hand: aHandMorph
+ 	"Add custom menu items to the menu"
+ 
+ 	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ 	aCustomMenu addLine.
+ 	aCustomMenu addUpdating: #autoStartString  target: self action: #toggleAutoStart.
+ 	aCustomMenu addUpdating: #autoDismissString  target: self action: #toggleAutoDismiss.
+ 	aCustomMenu addLine.
+ 
+ 	aCustomMenu addLine.
+ 	aCustomMenu add: 'change caption' translated target: self action: #changeCaption.
+ 	aCustomMenu add: 'open in recording theatre' translated target: self action: #openInRecordingSpace!

Item was added:
+ ----- Method: EventPlaybackButton>>autoDismiss: (in category 'accessing') -----
+ autoDismiss: anObject
+ 	"Set the value of autoDismiss"
+ 
+ 	autoDismiss _ anObject!

Item was added:
+ ----- Method: EventPlaybackButton>>autoDismissString (in category 'menu ') -----
+ autoDismissString
+ 	"Answer a string telling the status of my autoDismiss."
+ 
+ 	^ ((autoDismiss == true)
+ 		ifTrue:
+ 			['<yes>']
+ 		ifFalse:
+ 			['<no>']), 'auto dismiss' translated!

Item was added:
+ ----- Method: EventPlaybackButton>>autoStart: (in category 'accessing') -----
+ autoStart: anObject
+ 	"Set the value of autoStart"
+ 
+ 	autoStart _ anObject!

Item was added:
+ ----- Method: EventPlaybackButton>>autoStartString (in category 'menu ') -----
+ autoStartString
+ 	"Answer a string telling the status of my autoStart."
+ 
+ 	^ ((autoStart == true)
+ 		ifTrue:
+ 			['<yes>']
+ 		ifFalse:
+ 			['<no>']), 'auto start' translated!

Item was added:
+ ----- Method: EventPlaybackButton>>caption (in category 'accessing') -----
+ caption
+ 	"Answer the caption."
+ 
+ 	^ caption!

Item was added:
+ ----- Method: EventPlaybackButton>>caption: (in category 'accessing') -----
+ caption: anObject
+ 	"Set the value of caption"
+ 
+ 	caption _ anObject!

Item was added:
+ ----- Method: EventPlaybackButton>>changeCaption (in category 'menu ') -----
+ changeCaption
+ 	"Allow the user to edit the caption name for this button.  Create a new button with the new caption."
+ 
+ 	| result interimSpace newButton |
+ 	result := FillInTheBlank request: 'Please edit the caption' translated initialAnswer:  caption.
+ 	result isEmptyOrNil ifTrue: [^ self].
+ 	caption := result.
+ 	interimSpace := EventRecordingSpace new.
+ 	interimSpace initializeFromPlaybackButton: self.
+ 	newButton := self class new initializeFrom: interimSpace.
+ 	self labelGraphic: newButton imageForm!

Item was added:
+ ----- Method: EventPlaybackButton>>contentArea (in category 'accessing') -----
+ contentArea
+ 	"Answer my contentArea, a Worldlet."
+ 
+ 	^ contentArea!

Item was added:
+ ----- Method: EventPlaybackButton>>duration (in category 'initialization') -----
+ duration
+ 	"Answer what the duration of event-movie represented by the receiver would be."
+ 
+ 	^ EventRecorderMorph durationOfTape: tape!

Item was added:
+ ----- Method: EventPlaybackButton>>durationInMilliseconds (in category 'accessing') -----
+ durationInMilliseconds
+ 	"Answer the duration of the activity represented by the receiver, in milliseconds."
+ 
+ 	^ MentoringEventRecorder durationInMillisecondsOfTape:  tape!

Item was added:
+ ----- Method: EventPlaybackButton>>finalPicture (in category 'accessing') -----
+ finalPicture
+ 	"Answer the value of finalPicture"
+ 
+ 	^ finalPicture!

Item was added:
+ ----- Method: EventPlaybackButton>>finalPicture: (in category 'accessing') -----
+ finalPicture: anObject
+ 	"Set the value of finalPicture"
+ 
+ 	finalPicture _ anObject!

Item was added:
+ ----- Method: EventPlaybackButton>>initialPicture (in category 'accessing') -----
+ initialPicture
+ 	"Answer the value of initialPicture"
+ 
+ 	^ initialPicture!

Item was added:
+ ----- Method: EventPlaybackButton>>initialPicture: (in category 'accessing') -----
+ initialPicture: anObject
+ 	"Set the value of initialPicture"
+ 
+ 	initialPicture _ anObject!

Item was added:
+ ----- Method: EventPlaybackButton>>initializeFrom: (in category 'initialization') -----
+ initializeFrom: anEventRecordingSpace
+ 	"Initialize the receiver to be a button which will play the sequence currenty defined in the given event-recording space."
+ 
+ 	self initializeToShow: anEventRecordingSpace initialContentArea withLabel: anEventRecordingSpace captionString andSend: #launchPlayback to: self.
+ 	"Icon is made with the recording space in whatever state the user prefers -- may be at the beginning or end of playback, for example."
+ 
+ 	autoStart := true.
+ 	autoDismiss := true.
+ 
+ 	anEventRecordingSpace rewind.
+ 	contentArea := anEventRecordingSpace initialContentArea veryDeepCopy.
+ 	tape := anEventRecordingSpace eventRecorder tape veryDeepCopy.
+ 	caption := anEventRecordingSpace captionString veryDeepCopy.
+ 	initialPicture := anEventRecordingSpace initialPicture veryDeepCopy.
+ 	finalPicture := anEventRecordingSpace finalPicture veryDeepCopy.
+ 
+ 	self on: #click send: nil to: nil.  "Undo generic IconicButton evt handler"
+ 	self target: self; actionSelector: #launchPlayback; arguments: #().
+ 	self actWhen: #buttonUp.
+ 
+ 	anEventRecordingSpace balloonHelpString ifNotNilDo:
+ 		[:t | self setBalloonText: t]
+ 
+ 
+ 	!

Item was added:
+ ----- Method: EventPlaybackButton>>launchPlayback (in category 'initialization') -----
+ launchPlayback
+ 	"Launch a playback window."
+ 
+ 	| aPlaybackSpace |
+ 	aPlaybackSpace := EventPlaybackSpace new.
+ 	aPlaybackSpace setProperty: #originatingButton toValue: self.
+ 	aPlaybackSpace contentArea: contentArea veryDeepCopy tape: tape veryDeepCopy.
+ 	aPlaybackSpace captionString: caption.
+ 	aPlaybackSpace position: 0 at 0.
+ 	aPlaybackSpace rewind.
+ 	aPlaybackSpace autoStart: (autoStart == true).
+ 	aPlaybackSpace autoDismiss: (autoDismiss == true).
+ 
+ 	aPlaybackSpace openInWorld.
+ 	autoStart == true ifTrue: [aPlaybackSpace play]
+ !

Item was added:
+ ----- Method: EventPlaybackButton>>openInRecordingSpace (in category 'button') -----
+ openInRecordingSpace
+ 	"Open a new EventRecordingSpace based on the receiver."
+ 
+ 	EventRecordingSpace openFromPlaybackButton: self!

Item was added:
+ ----- Method: EventPlaybackButton>>playbackConcludedIn: (in category 'initialization') -----
+ playbackConcludedIn: aPlaybackSpace
+ 	"A playback invoked by the receiver has concluded; if appropriate, change the appearance of the receiver."!

Item was added:
+ ----- Method: EventPlaybackButton>>putEventsOnto: (in category 'event roll') -----
+ putEventsOnto: aStream
+ 	"Put events onto a stream that will create a revised event tape for the an event theatre."
+ 
+ 	| aNewEvent anEventRoll |
+ 	aNewEvent :=  MediaPlayEvent new.
+ 	anEventRoll := self ownerThatIsA: EventRollMorph.
+ 	aNewEvent setType: #startEventPlayback argument: self hand: nil stamp: (anEventRoll timeStampForCurrentPositionOf: self).
+ 	aStream nextPut: aNewEvent!

Item was added:
+ ----- Method: EventPlaybackButton>>suitableForDroppingIntoEventRoll (in category 'drag and drop') -----
+ suitableForDroppingIntoEventRoll
+ 	"Answer whether the receiver is suitable for dropping into an eventRoll"
+ 
+ 	^ true!

Item was added:
+ ----- Method: EventPlaybackButton>>tape (in category 'accessing') -----
+ tape
+ 	"Answer the tape"
+ 
+ 	^ tape!

Item was added:
+ ----- Method: EventPlaybackButton>>tape: (in category 'accessing') -----
+ tape: anObject
+ 	"Set the value of tape"
+ 
+ 	tape _ anObject!

Item was added:
+ ----- Method: EventPlaybackButton>>toggleAutoDismiss (in category 'menu ') -----
+ toggleAutoDismiss
+ 	"Toggle my autoDismiss state."
+ 
+ 	autoDismiss := (autoDismiss == true)  not!

Item was added:
+ ----- Method: EventPlaybackButton>>toggleAutoStart (in category 'menu ') -----
+ toggleAutoStart
+ 	"Toggle my autoStart state."
+ 
+ 	autoStart := (autoStart == true) not!

Item was added:
+ EventRecordingSpace subclass: #EventPlaybackSpace
+ 	instanceVariableNames: 'autoStart autoDismiss'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !EventPlaybackSpace commentStamp: 'sw 10/11/2006 03:41' prior: 0!
+ An area used for playback of event-recorded movies, as it were.!

Item was added:
+ ----- Method: EventPlaybackSpace>>abandon (in category 'commands') -----
+ abandon
+ 	"Abandon the entire exercise."
+ 
+ 	self delete.
+ 	self dismantlePaintBoxArtifacts.
+ 	self abandonReplayHandsAndHalos.
+ 	(self valueOfProperty: #stopper) ifNotNilDo:
+ 		[:stopper | stopper delete].
+ 	(self valueOfProperty: #originatingButton) ifNotNilDo:
+ 		[:aButton | aButton playbackConcludedIn: self]!

Item was added:
+ ----- Method: EventPlaybackSpace>>addCustomMenuItems:hand: (in category 'menu') -----
+ addCustomMenuItems: aCustomMenu hand: aHandMorph
+ 	"Add morph-specific items to the given menu which was invoked by the given hand.  This method is invoked both from the halo-menu and from the control-menu regimes."
+ 
+ 	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ 	aCustomMenu addTranslatedList: #(
+ 		( 'open for score-editing' openForScoreEditing  'Display this event-movie in a form such that its score can be viewed and edited.')) translatedNoop
+ !

Item was added:
+ ----- Method: EventPlaybackSpace>>addMenuButtonItemsTo: (in category 'menu') -----
+ addMenuButtonItemsTo: aMenu
+ 	"Subclasses wishing to partake of generic menuButton support should reimplement this, and *not* call super ;-)"
+ 
+ 	aMenu addTranslatedList: #(
+ 		('rewind'				rewind)
+ 		('play again'			play)) translatedNoop.
+ 	Preferences debugging ifTrue:
+ 		[aMenu addTranslatedList: #(
+ 		-
+ 		('inspect' inspect)
+ 		-
+ 		('edit this menu' editMenuButtonDefinition)) translatedNoop]!

Item was added:
+ ----- Method: EventPlaybackSpace>>addStopper (in category 'initialization') -----
+ addStopper
+ 	"Add a control that can be clicked to make the playback stop."
+ 
+ 	| aStopper |
+ 	aStopper := self tanOButton.
+ 	aStopper on: #mouseDown send: #abandon to: self.
+ 	self setProperty: #stopper toValue: aStopper.
+ 	aStopper openInWorld.
+ 	aStopper topLeft: (self topLeft - (6 at 6))!

Item was added:
+ ----- Method: EventPlaybackSpace>>autoDismiss: (in category 'accessing') -----
+ autoDismiss: anObject
+ 	"Set the value of autoDismiss"
+ 
+ 	autoDismiss _ anObject!

Item was added:
+ ----- Method: EventPlaybackSpace>>autoStart: (in category 'accessing') -----
+ autoStart: anObject
+ 	"Set the value of autoStart"
+ 
+ 	autoStart _ anObject!

Item was added:
+ ----- Method: EventPlaybackSpace>>comeToFront (in category 'commands') -----
+ comeToFront
+ 	"Bring the receiver to the front, then its dismisser in front of it."
+ 
+ 	super comeToFront.
+ 	(self valueOfProperty: #stopper) ifNotNilDo:
+ 		[:s | s comeToFront]!

Item was added:
+ ----- Method: EventPlaybackSpace>>contentArea:tape: (in category 'initialization') -----
+ contentArea: anArea tape: aTape
+ 	"Basic initialization:  Set the receiver's contentArea &  tape."
+ 
+ 	autoStart := false.  "Caller will change these subsequenty if needed"
+ 	autoDismiss := false.
+ 
+ 	contentArea ifNotNil: [contentArea delete].
+ 	initialContentArea := anArea veryDeepCopy.
+ 	self restoreInitialContentArea.
+ 	eventRecorder tape: aTape veryDeepCopy.
+ 	eventRecorder recordingSpace: self.
+ 	eventRecorder noteAreaBounds.
+ 
+ 	self color:  (Color r: 0.677 g: 0.935 b: 0.484)
+ 
+ 	!

Item was added:
+ ----- Method: EventPlaybackSpace>>launchFrom: (in category 'initialization') -----
+ launchFrom: aButton
+ 	"Initialize the receiver from an invoker button, and launch it."
+ 	
+ 	| where |
+ 	self setProperty: #originatingButton toValue: aButton.
+ 	self contentArea: aButton contentArea veryDeepCopy tape: aButton tape veryDeepCopy.
+ 	self captionString: aButton caption.
+ 	self rewind.
+ 	autoStart := aButton autoStart.
+ 	autoDismiss := aButton autoDismiss.
+ 
+ 	"showChrome  := aButton showChrome."
+ 	where := aButton whereToAppear.
+ 
+ 	self openInWorld.
+ 	where = #screenCenter ifTrue: [self center: ActiveWorld center].
+ 	where = #buttonPosition ifTrue: [self position: aButton position].
+ 	where = #containerOrigin ifTrue: [self position: aButton owner position].
+ 	self goHome.
+ 	self addStopper.
+ 
+ 	autoStart ifTrue: [self play]!

Item was added:
+ ----- Method: EventPlaybackSpace>>okayToResizeEasily (in category 'processing') -----
+ okayToResizeEasily
+ 	"Answer whether the receiver would be glad to offer a grow handle."
+ 
+ 	^ false!

Item was added:
+ ----- Method: EventPlaybackSpace>>okayToRotateEasily (in category 'processing') -----
+ okayToRotateEasily
+ 	"Answer whether it is appropriate for a rotation handle to be shown for the receiver. "
+ 
+ 	^ false!

Item was added:
+ ----- Method: EventPlaybackSpace>>openForScoreEditing (in category 'commands') -----
+ openForScoreEditing
+ 	"Open the receiver's event-movie in a conventional EventRecordingSpace."
+ 
+ 	| aButton aSpace |
+ 	aButton := self valueOfProperty: #originatingButton ifAbsent: [^ self].
+ 
+ 	aSpace := EventRecordingSpace new.
+ 	aSpace initializeFromPlaybackButton: aButton.
+ 	aSpace openInWorld.
+ 	aSpace center: self center.
+ 	self abandon!

Item was added:
+ ----- Method: EventPlaybackSpace>>playingEnded (in category 'processing') -----
+ playingEnded
+ 	"The playback reached the end."
+ 
+ 	self dismantlePaintBoxArtifacts.
+ 	autoDismiss ifTrue: [^ self abandon].
+ 
+ 	self state: #atEndOfPlayback.
+ 	self populateControlsPanel.
+ 	self borderColor: self color.
+ 	self abandonReplayHandsAndHalos.
+ 	self removeAlarm: #offerTickingMenu:.  "In case timing is unlucky"
+ !

Item was added:
+ ----- Method: EventPlaybackSpace>>playingStopped (in category 'processing') -----
+ playingStopped
+ 	"The playback reached the end"
+ 
+ 	self dismantlePaintBoxArtifacts.
+ 	autoDismiss ifTrue: [^ self abandon].
+ 
+ 	state := #atEndOfPlayback.
+ 	self populateControlsPanel.
+ 	self borderColor: self color.
+ 	self abandonReplayHandsAndHalos
+ !

Item was added:
+ ----- Method: EventPlaybackSpace>>populateControlsPanel (in category 'processing') -----
+ populateControlsPanel
+ 	"Build the things that need to be in the controls panel."
+ 
+ 	((autoStart = true) and: [autoDismiss = true]) ifTrue:
+ 		[controlsPanel delete.
+ 		soundPanel delete.
+ 		^ self].
+ 
+ 	showingSoundButton ifNil: [self initialize.  self makeStatusButtons].  "bkwd compat"
+ 
+ 	controlsPanel color:  (Color r: 0.677 g: 0.935 b: 0.484).
+ 	controlsPanel removeAllMorphs.
+ 	soundPanel ifNotNil: [soundPanel delete].
+ 
+ 	(autoStart == true and:  [autoDismiss == true]) ifTrue: [^ self]. 
+ 
+ 	controlsPanel  addVariableTransparentSpacer.
+ 
+ 	self addControlWithSpacer: abandonButton.
+ "	self addControlWithSpacer: menuButton."
+ 	self addControlWithSpacer: captionMorph lock.
+ 
+ 	state = #playback ifTrue: [self addControlWithSpacer: stopButton].
+ 	self addControlWithSpacer: rewindButton.
+ 	(#(rewound atEndOfPlayback) includes: state) ifTrue: [self addControlWithSpacer: playButton]
+ 
+ !

Item was added:
+ ----- Method: EventPlaybackSpace>>putUpHelpFlap (in category 'initialization') -----
+ putUpHelpFlap
+ 	"If appropriate, put up (if not alredy present) a flap giving documentation.  Present here to override EventRecordingSpace's wish to put up a help flap in this situation."
+ 
+ 	!

Item was added:
+ ----- Method: EventRecorderMorph class>>durationOfTape: (in category '*Etoys-Squeakland-queries') -----
+ durationOfTape: aTape
+ 	"Answer the total duration of the events in a tape, in miliseconds, in a sledgehammer fashion."
+ 
+ 	| baseline total |
+ 	aTape isEmptyOrNil ifTrue: [^ 10].
+ 
+ 	total := 0.
+ 	baseline := aTape first timeStamp.
+ 	aTape do:
+ 		[:evt |
+ 			evt type = #noCondense ifFalse: "annoying non-cooperator!!"
+ 				[total := total max: (evt timeStamp + evt durationInMilliseconds - baseline)]].
+ 	^ total!

Item was added:
+ ----- Method: EventRecorderMorph class>>formerDescriptionForPartsBin (in category '*Etoys-Squeakland-parts bin') -----
+ formerDescriptionForPartsBin
+ 	"Answer  a description for use in a parts bin... formerly, that is."
+ 
+ 	^ self partName: 'Event Recorder' translatedNoop
+ 		categories: {'Multimedia' translatedNoop}
+ 		documentation: 'Lets you record and play back interactions' translatedNoop!

Item was added:
+ ----- Method: EventRecorderMorph>>areaBounds: (in category '*Etoys-Squeakland-accessing') -----
+ areaBounds: rect
+ 
+ 	areaBounds _ rect!

Item was added:
+ ----- Method: EventRecorderMorph>>copyScriptingArea (in category '*Etoys-Squeakland-commands') -----
+ copyScriptingArea
+ 	"When recording inside a ScriptingArea, make a copy of it and all its objects before starting to record.  Hold the copy in property #primalConfig.  When stop recording, insert tape into copy, install in an icon, and place on the desktop.  Scripting area marked with property #tutorial."
+ 
+ 	| tutorial primalCopy |
+ 	areaOffset _ 0 at 0.  "just in case"
+ 	tutorial _ self firstOwnerSuchThat: [:mm | mm hasProperty: #tutorial].
+ 	tutorial ifNil: [areaBounds _ 0 at 0 corner: 10000 at 10000.	"no translation"
+ 		^ false].	"do nothing if not embedded in a tutorial scripting area"
+ 	self setProperty: #primalConfig toValue: nil. 	"remove old"
+ 	primalCopy _ tutorial veryDeepCopy.
+ 	self setProperty: #primalConfig toValue: primalCopy.
+ 
+ 	"record the bounds"
+ 	areaBounds _ tutorial bounds.
+ 	^ true
+ 	!

Item was added:
+ ----- Method: EventRecorderMorph>>createPlayButton (in category '*Etoys-Squeakland-commands') -----
+ createPlayButton
+ 	"Make a simple button interface for replay only"
+ 
+ 	| butnCaption erm |
+ 	butnCaption _ FillInTheBlank request: 'Caption for this button?' translated initialAnswer: 'play' translated.
+ 	butnCaption isEmpty ifTrue: [^ self].
+ 	erm _ (EventRecorderMorph basicNew
+ 				caption: butnCaption
+ 				voiceRecorder: voiceRecorder copy
+ 				tape: tape) initialize.
+ 	self world primaryHand attachMorph: erm!

Item was added:
+ ----- Method: EventRecorderMorph>>doNotCondense: (in category '*Etoys-Squeakland-events-processing') -----
+ doNotCondense: action
+ 	"When a user gesture should not have its points condensed, such as painting a stroke, this is called with the symbol action.  Also called with #mouseUp: when a stroke is finished.
+ 	New kind of event:  CondenseAllowEvent, CondenseForbidEvent.  Insert one at start of stroke, and one at end."
+ 
+ 	| strokeEvent |
+ 	(#(#paint: #erase: #stamp:) includes: action) ifTrue: [
+ 		noCondense == true ifFalse: [noCondense _ true.
+ 			strokeEvent _ MorphicUnknownEvent new setType: #noCondense argument: action.
+ 			tapeStream nextPut: strokeEvent.
+ 			journalFile ifNotNil: [journalFile store: strokeEvent; cr; flush]].
+ 		^ self].
+ 	action == #mouseUp: ifTrue: [noCondense _ false.
+ 			strokeEvent _ MorphicUnknownEvent new setType: #noCondense argument: action.
+ 			tapeStream nextPut: strokeEvent.
+ 			journalFile ifNotNil: [journalFile store: strokeEvent; cr; flush].
+ 			^ self].
+ 	"A way to report which events not caught"
+ 	"noCondense == true ifFalse: [Transcript show: 'Assume this paint action is just a click: ',action; cr]."
+ !

Item was added:
+ ----- Method: EventRecorderMorph>>findPlayOffset (in category '*Etoys-Squeakland-commands') -----
+ findPlayOffset
+ 	"If Scripting Area has moved, prepare to offset all events"
+ 
+ 	| tutorial |
+ 	areaOffset _ 0 at 0	"just in case".
+ 	tutorial _ self firstOwnerSuchThat: [:mm | mm hasProperty: #tutorial].
+ 	tutorial ifNil: [^ false].	"do nothing if not embedded in a tutorial scripting area"
+ 	areaBounds ifNil: [^ false].
+ 
+ 	areaOffset _ tutorial bounds origin - areaBounds origin.!

Item was added:
+ ----- Method: EventRecorderMorph>>makeStatusLightIn: (in category '*Etoys-Squeakland-initialization') -----
+ makeStatusLightIn: aPoint
+ 
+ 	^statusLight _ EllipseMorph new 
+ 		extent: aPoint;
+ 		color: Color green;
+ 		borderWidth: 0!

Item was added:
+ ----- Method: EventRecorderMorph>>mergeTapes: (in category '*Etoys-Squeakland-fileIn/Out') -----
+ mergeTapes: anArray
+ 	"Read multiple tapes and merge two timestamps"
+ 	"(self new mergeTapes: #('ClickStart.tape' 'Drawing.tape')) openInHand"
+ 	| lastTape offset writer aStream aTape |
+ 	lastTape := nil.
+ 	offset := 0.
+ 	writer := #() writeStream.
+ 	anArray do: [:fileName |
+ 		aStream := FileStream readOnlyFileNamed: fileName.
+ 		[aTape := self readFrom: aStream] ensure: [aStream close].
+ 		lastTape ifNotNil: [
+ 			offset := lastTape last timeStamp - aTape first timeStamp.
+ 		aTape do: [:each | each setTimeStamp: each timeStamp + offset]].
+ 		writer nextPutAll: aTape.
+ 		lastTape := aTape].
+ 	tape :=  writer contents.
+ 	saved _ true  "Still exists on file"!

Item was added:
+ ----- Method: EventRecorderMorph>>objectTrackingEvents (in category '*Etoys-Squeakland-event handling') -----
+ objectTrackingEvents
+ 	"Answer an object tracking events or pseudo-event, nil for none.  This is a hook allowing the EventRecordingSpace to keep track of cursor position to provide to event rolls."
+ 
+ 	^ nil!

Item was added:
+ ----- Method: EventRecorderMorph>>perhapsPlaySound: (in category '*Etoys-Squeakland-event handling') -----
+ perhapsPlaySound: aSound
+ 	"Perhaps play given sound.  But, if busy creating a voiceover, do not."
+ 
+ 	aSound play!

Item was added:
+ ----- Method: EventRecorderMorph>>playHand (in category '*Etoys-Squeakland-accessing') -----
+ playHand
+ 	^ playHand!

Item was added:
+ ----- Method: EventRecorderMorph>>rememberPaintBoxSettingsAtRecordingOutset (in category '*Etoys-Squeakland-commands') -----
+ rememberPaintBoxSettingsAtRecordingOutset
+ 	"Recording is about to take place.  Remember settings if appropriate."!

Item was added:
+ ----- Method: EventRecorderMorph>>spawnStartingState (in category '*Etoys-Squeakland-commands') -----
+ spawnStartingState
+ 	"When recording stops, and we are inside a scripting area, and we have a primalConfig saved, install tape in recorder in primalConfig,  Install a button on the desktop containg the primalConfig, and remove it from this scripting area.  (This area, the end configuration, can be used to start the next tutorial.)"
+ 
+ 	| tutorial primalCopy recorderInPrimal |
+ 	"are we a tutorial?"
+ 	tutorial _ self firstOwnerSuchThat: [:mm | mm hasProperty: #tutorial].
+ 	tutorial ifNil: [^ false].	"do nothing if not embedded in a tutorial scripting area"
+ 	
+ 	"Do we have a complete copy of the starting configuration of this scripting area?"
+ 	primalCopy _ self valueOfProperty: #primalConfig ifAbsent: [^ false].
+ 	primalCopy ifNil: [^ false].
+ 	recorderInPrimal _ primalCopy 
+ 		findDeepSubmorphThat: [:mm | mm isKindOf: EventRecorderMorph] 
+ 		ifAbsent: [^ false].
+ 	"transfer the recorded tape"
+ 	recorderInPrimal tape: tape.
+ 	recorderInPrimal areaBounds: areaBounds.
+ 	
+ 	"make a button with thumbnail"
+ 	"newButton _ Morph new."
+ 	"install the saved scripting area"
+ 	"place button in owner"
+ 	tutorial owner ifNotNil: [tutorial owner addMorph: primalCopy].
+ 	"tutorial owner ifNotNil: [tutorial owner addMorph: newButton].
+ 	 newButton position: tutorial topRight + (10@(5 random * 40))."
+ 	self setProperty: #primalConfig toValue: nil. 	"remove from me"
+ 	^ true
+ !

Item was added:
+ ----- Method: EventRecorderMorph>>state (in category '*Etoys-Squeakland-accessing') -----
+ state
+ 	^state!

Item was added:
+ ----- Method: EventRecorderMorph>>tape: (in category '*Etoys-Squeakland-accessing') -----
+ tape: anArray
+ 	tape _ anArray!

Item was added:
+ ----- Method: EventRecorderMorph>>userStopReplayMaybe: (in category '*Etoys-Squeakland-pause/resume') -----
+ userStopReplayMaybe: anEvent
+ 	"If the user clicks or types a keystroke during replay, return true so we can stop the replay."
+ 
+ 	state == #play ifFalse: [^ false].
+ 	(anEvent hand isKindOf: HandMorphForReplay) ifTrue: [^ false].	"ignore own events"
+ 	(anEvent isKeyboard or: [anEvent isMouse and: [anEvent anyButtonPressed]]) 
+ 			ifFalse: [^ false]. "mouse move"
+ 	"got a click or keystroke"
+ 	^ true!

Item was added:
+ AlignmentMorph subclass: #EventRecordingSpace
+ 	instanceVariableNames: 'contentArea controlsPanel soundPanel publishButton abandonButton menuButton recordButton recordAgainButton recordVoiceoverButton stopRecordingVoiceoverButton scriptButton playButton rewindButton stopButton pauseButton resumeButton captionMorph showingSoundButton eventRecorder state initialContentArea balloonHelpString initialPicture finalPicture showingSoundPanel eventRoll priorVersions'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !EventRecordingSpace commentStamp: 'sw 12/24/2006 16:10' prior: 0!
+ Externally called the Event Theatre, this is a tool for authoring event-recorded sequences with possible voiceover.  Event "tapes" created with an Event Theatre can be edited using the Event Roll.
+ 
+ Values for the "state" instance variable, which characterizes the combined state of an Event-Theatre + MentoringEventRecorder complex:
+ 
+ readyToRecord				No recording ever made
+ 
+ rewound						Recording exists; not actively doing anything, and recently rewound.
+ atEndOfPlayback				Recording exists; not actively doing anything; played since last rewind.
+ 
+ recordingWithSound			Currently making primary recording, with sound
+ recording						Currently making primary recording, sans sound
+ 
+ playback
+ playbackAddingVoiceover	Currently running playback while recording a voiceover for a portion of it
+ 
+ suspendedPlayback			In the midst of playback, user hit the Pause button!

Item was added:
+ ----- Method: EventRecordingSpace class>>defaultNameStemForInstances (in category 'instance creation') -----
+ defaultNameStemForInstances
+ 	"Answer the default name stem for new instances of this class"
+ 
+ 	^ 'Event Theatre' translatedNoop!

Item was added:
+ ----- Method: EventRecordingSpace class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	"Answer a description for use in a parts bin."
+ 
+ 	^ self partName:	'Event Theatre' translatedNoop
+ 		categories:		{'Multimedia' translatedNoop}
+ 		documentation:	'A framework for creating tutorial snippets' translatedNoop!

Item was added:
+ ----- Method: EventRecordingSpace class>>open (in category 'instance creation') -----
+ open
+ 	"Open up a new instance of the receiver."
+ 
+ 	| anInst |
+ 	anInst := self new.
+ 	anInst visible: false.
+ 	anInst openInWorldOrWorldlet.
+ 	anInst center:  anInst owner center.
+ 	anInst show
+ 	
+ 
+ "
+ EventRecordingSpace open.
+ "!

Item was added:
+ ----- Method: EventRecordingSpace class>>openCentered (in category 'instance creation') -----
+ openCentered
+ 	"Open up a new instance of the receiver, centered "
+ 
+ 	| anInst |
+ 	anInst := self new.
+ 	anInst visible: false.
+ 	anInst openInWorldOrWorldlet.
+ 	anInst center:  anInst owner center.
+ 	anInst show.
+ 	"anInst putUpHelpFlap"
+ "
+ EventRecordingSpace open.
+ "!

Item was added:
+ ----- Method: EventRecordingSpace class>>openFromPlaybackButton: (in category 'instance creation') -----
+ openFromPlaybackButton: aButton
+ 	"Open an EventRecordingSpace derived from a playback button.  The primary reason for doing this would be to re-record voiceover."
+ 
+ 	| aSpace |
+ 	aSpace := EventRecordingSpace new.
+ 	aSpace initializeFromPlaybackButton: aButton.
+ 	aSpace center: ActiveWorld center.
+ 	aSpace openInWorld!

Item was added:
+ ----- Method: EventRecordingSpace>>abandon (in category 'commands') -----
+ abandon
+ 	"Abandon the entire exercise."
+ 
+ 	(state ~= #readyToRecord and: [eventRecorder saved not]) ifTrue:
+ 		[(PopUpMenu confirm:
+ 'The current recording has not been saved, and will be
+ lost if you do this; are you sure you want to proceed?' translated trueChoice: 'yes, abandon this Event Theatre' translated falseChoice: 'no, let me reconsider' translated) ifFalse: [^ self]].
+ 
+ 	eventRoll ifNotNil: [eventRoll delete].
+ 	eventRoll := nil.
+ 	self topRendererOrSelf delete.
+ 	self abandonReplayHandsAndHalos!

Item was added:
+ ----- Method: EventRecordingSpace>>abandonReplayHandsAndHalos (in category 'commands') -----
+ abandonReplayHandsAndHalos
+ 	"Cleanup after playback."
+ 
+ 	ActiveWorld abandonReplayHandsAndHalosFor: eventRecorder!

Item was added:
+ ----- Method: EventRecordingSpace>>acceptNewTape: (in category 'event roll') -----
+ acceptNewTape: aTape
+ 	"Accept the given tape as the new one for this event-theatre.  This comes from editing the event-tape using the EventRoll."
+ 
+ 	eventRecorder tape: aTape.
+ 	self rememberCurrentRecording
+ !

Item was added:
+ ----- Method: EventRecordingSpace>>addControlWithSpacer: (in category 'processing') -----
+ addControlWithSpacer: aControl
+ 	"Add the control, followed by a variable transparent spacer, to my controls panel."
+ 
+ 	controlsPanel addMorphBack: aControl.
+ 	controlsPanel  addVariableTransparentSpacer!

Item was added:
+ ----- Method: EventRecordingSpace>>addMenuButtonItemsTo: (in category 'menu') -----
+ addMenuButtonItemsTo: aMenu
+ 	"Build the contents of the menu to be presented when the menu button in my tool-bar is clicked."
+ 
+ 	"CAUTION:  Debugging items still present."
+ 
+ 	aMenu addTitle: 'Recording Options' translated.
+ 
+ 	aMenu addTranslatedList: #(
+ 		('set balloon help'		setBalloonHelp  'Allows you to provide a message to be presented to a user as balloon-help when the mouse lingers over buttons that trigger playback of the tape of this event theatre')
+ 		('shrink event tape' shrinkTape)
+ 		"('save on file...' saveSequenceOnFile)"
+ 		-
+ 		('revert to version...'	offerVersions)
+ 		('delete old versions'	deleteOldVersions)
+ 		-) translatedNoop.
+ 
+ 	SugarNavigatorBar showSugarNavigator
+ 		ifTrue:
+ 			[aMenu addTranslatedList: (self sugarNavigatorFlapOrNil
+ 				ifNil: [#(('add sugar navigator flap' addSugarNavigatorFlap)) translatedNoop]
+ 				ifNotNil: [#(('remove sugar navigatorFlap' removeSugarNavigatorFlap)) translatedNoop])]
+ 		ifFalse:
+ 			[aMenu addTranslatedList: (self navigatorFlapOrNil
+ 				ifNil: [#(('add navigator flap' addNavigatorFlap)) translatedNoop]
+ 				ifNotNil: [#(('remove navigatorFlap' removeNavigatorFlap)) translatedNoop]).
+ 
+ 			aMenu addTranslatedList: (self suppliesFlapOrNil
+ 				ifNil: [#(('add supplies flap' addSuppliesFlap)) translatedNoop]
+ 				ifNotNil: [#(('remove suppliesFlap' removeSuppliesFlap)) translatedNoop])].
+ 
+ 	aMenu addTranslatedList: #(
+ 		-
+ 		('event roll' makeHorizontalRoll 'open a horizontal piano-roll-like tool for the viewing and editing the events of this event theatre.')
+ 		('remove event-roll' removeEventRoll  'abandon any event-roll that may be associated with this theatre.')
+ 		-) translatedNoop.
+ 
+ 	Preferences debugging ifTrue:
+ 		[self addMoreSubMenuTo: aMenu]!

Item was added:
+ ----- Method: EventRecordingSpace>>addMoreSubMenuTo: (in category 'menu') -----
+ addMoreSubMenuTo: aMenu
+ 	"Add the 'more...' submenu to a menu."
+ 
+ 	| submenu |
+ 	submenu := MenuMorph new defaultTarget: self.
+ 	submenu addTitle: 'More options' translated.
+ 
+ 	submenu addTranslatedList: #(
+ 		('inspect event theatre' inspect)
+ 		('inspect event recorder' inspectEventRecorder)
+ 		('inspect sound recorder' inspectSoundRecorder)
+ 		('inspect event tape' inspectEventTape)
+ 		('inspect event roll' inspectEventRoll)
+ 		('inspect nav bar' inspectNavBar)
+ 		-
+ 		('parse event tape' parseEventTape)
+ 		('convert to canonical coordinates (broken)' convertToCanonicalForm)
+ 		('movie-clip player'  addMovieClipPlayer)) translatedNoop.
+ 
+ 	aMenu add: 'more...' translated subMenu: submenu!

Item was added:
+ ----- Method: EventRecordingSpace>>addNavigatorFlap (in category 'flaps') -----
+ addNavigatorFlap
+ 	"Add a navigator flap if there is none."
+ 
+ 	| existing aFlap navBar aFlapTab |
+ 	existing := contentArea submorphs detect: [:aMorph | (aMorph isKindOf: FlapTab) and: [aMorph flapID = 'Navigator']] ifNone: [nil].
+ 	existing ifNotNil: [^ self].  "already present"
+ 
+ 	navBar _ EventRecordingSpaceNavigator new.
+ 	aFlap _ PasteUpMorph newSticky borderWidth: 0;
+ 			extent: navBar extent + (0 at 20);
+ 			color: (Color orange alpha: 0.8);
+ 			beFlap: true;
+ 			addMorph: navBar beSticky.
+ 	aFlap hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ 	aFlap useRoundedCorners.
+ 	aFlap setNameTo: 'Navigator' translated.
+ 	navBar fullBounds.  "to establish width"
+ 	
+ 	aFlapTab _ InteriorFlapTab new referent: aFlap.
+ 	aFlapTab setName: 'Navigator' translated edge: #bottom color: Color orange.
+ 
+ 	aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
+ 	aFlap borderWidth: 0.
+ 	contentArea addMorphFront: aFlapTab.
+ 	aFlapTab position: (contentArea bottomLeft + (0 @ -24)).
+ 	aFlapTab referent left: (aFlapTab center x - (aFlapTab referent width//2) max: 0).
+ 	contentArea installFlaps
+ !

Item was added:
+ ----- Method: EventRecordingSpace>>addSugarNavigatorFlap (in category 'flaps') -----
+ addSugarNavigatorFlap
+ 	"If the content area does not have a sugar-navigator flap, give it one."
+ 
+ 	| existing aBar |
+ 	existing := contentArea submorphs detect: [:aMorph | aMorph isKindOf: InteriorSugarNavBar] ifNone: [nil].
+ 	existing ifNotNil: [^ self].  "already present"
+ 
+ 	aBar := InteriorSugarNavBar new.
+ 	contentArea addMorphFront: aBar.
+ 	aBar position: contentArea position.
+ 	aBar finishInitialization.
+ 	contentArea installFlaps
+ 
+ !

Item was added:
+ ----- Method: EventRecordingSpace>>addSuppliesFlap (in category 'flaps') -----
+ addSuppliesFlap
+ 	"If the content area does not have a Supplies flap, give it one."
+ 
+ 	| existing aFlap actualFlap |
+ 	existing := contentArea submorphs detect: [:aMorph | (aMorph isKindOf: FlapTab) and: [aMorph flapID = 'Supplies']] ifNone: [nil].
+ 	existing ifNotNil: [^ self].  "already present"
+ 
+ 	aFlap := Flaps newSuppliesFlapFromQuads: Flaps quadsDefiningPlugInSuppliesFlap positioning: #right.
+ 	contentArea addMorphFront: (actualFlap := aFlap as: InteriorFlapTab).
+ 	actualFlap setToPopOutOnDragOver: true.
+ 	actualFlap edgeToAdhereTo: #bottom.
+ 	actualFlap right: contentArea right.
+ 	contentArea installFlaps
+ 
+ !

Item was added:
+ ----- Method: EventRecordingSpace>>addToSoundPanelWithSpacer: (in category 'processing') -----
+ addToSoundPanelWithSpacer: aControl
+ 	"Add the control, followed by a variable transparent spacer, to my sound panel."
+ 
+ 	soundPanel addMorphBack: aControl.
+ 	soundPanel  addVariableTransparentSpacer!

Item was added:
+ ----- Method: EventRecordingSpace>>addVoiceControls (in category 'commands') -----
+ addVoiceControls
+ 	"Add  voice controls to the receiver."
+ 
+ 	eventRecorder addVoiceControls
+ 
+ !

Item was added:
+ ----- Method: EventRecordingSpace>>allNonSubmorphMorphs (in category 'processing') -----
+ allNonSubmorphMorphs
+ 	"Answer a list of morphs within me that are not submorphs."
+ 
+ 	^ {eventRecorder}!

Item was added:
+ ----- Method: EventRecordingSpace>>areaOffset (in category 'processing') -----
+ areaOffset
+ 	"Answer the difference between my content area and the one in which the events I will play back were recorded."
+ 
+ 	^ self contentArea bounds origin -  self contentAreaBoundsWhenRecorded origin !

Item was added:
+ ----- Method: EventRecordingSpace>>assureContentAreaStaysAt: (in category 'processing') -----
+ assureContentAreaStaysAt: aPoint
+ 	"selbst-verständlich"
+ 
+ 	ActiveWorld doOneCycleNow.
+ 	self topLeft: ((self topLeft - contentArea topLeft ) + aPoint)!

Item was added:
+ ----- Method: EventRecordingSpace>>assureUsingVoice (in category 'menu') -----
+ assureUsingVoice
+ 	"If not using voice controls, start using them."
+ 
+ 	eventRecorder voiceRecorder
+ 		ifNil:
+ 			[eventRecorder addVoiceControls.
+ 			self populateControlsPanel]!

Item was added:
+ ----- Method: EventRecordingSpace>>balloonHelpString (in category 'accessing') -----
+ balloonHelpString
+ 	"Answer the value of balloonHelpString"
+ 
+ 	^ balloonHelpString!

Item was added:
+ ----- Method: EventRecordingSpace>>balloonHelpString: (in category 'accessing') -----
+ balloonHelpString: anObject
+ 	"Set the value of balloonHelpString"
+ 
+ 	balloonHelpString _ anObject!

Item was added:
+ ----- Method: EventRecordingSpace>>blueButtonDown: (in category 'events-processing') -----
+ blueButtonDown: anEvent
+ 	"Special gestures (cmd-mouse on the Macintosh; Alt-mouse on Windows and Unix) allow a mouse-sensitive morph to be moved or bring up a halo for the morph."
+ 
+ 	(eventRecorder userStopReplayMaybe: anEvent) ifTrue: [^ self stopPlayback]. 
+ 	super blueButtonDown: anEvent.
+ !

Item was added:
+ ----- Method: EventRecordingSpace>>buttonWithLabel:actionSelector:balloonText: (in category 'initialization') -----
+ buttonWithLabel: aLabel actionSelector: aSelector balloonText: helpText
+ 	"Answer a button with the receiver as target, and with the given label, selector, and help text."
+ 
+ 	| aButton |
+ 	aButton := SimpleButtonMorph new label: aLabel translated font: (StrikeFont familyName: 'Accujen' size: 18).
+ 	aButton color: Color blue veryMuchLighter.
+ 	aButton target: self.
+ 	aButton actWhen: #buttonUp.
+ 	aButton actionSelector: aSelector.
+ 	helpText ifNotNil: [aButton setBalloonText: helpText translated].
+ 	^ aButton
+ !

Item was added:
+ ----- Method: EventRecordingSpace>>captionString (in category 'access') -----
+ captionString
+ 	"Answer the current caption string"
+ 
+ 	^ eventRecorder ifNil: ['Untitled'] ifNotNil: [eventRecorder caption]!

Item was added:
+ ----- Method: EventRecordingSpace>>captionString: (in category 'access') -----
+ captionString: aString
+ 	"Set my eventRecorder's captionString."
+ 
+ 	eventRecorder caption: aString!

Item was added:
+ ----- Method: EventRecordingSpace>>contentArea (in category 'access') -----
+ contentArea
+ 	"Answer the contentArea"
+ 
+ 	^ contentArea!

Item was added:
+ ----- Method: EventRecordingSpace>>contentAreaBoundsWhenRecorded (in category 'processing') -----
+ contentAreaBoundsWhenRecorded
+ 	"Answer the bounds of the content area at the time the recording was made."
+ 
+ 	^ initialContentArea
+ 		ifNil: 
+ 			[contentArea bounds]
+ 		ifNotNil:
+ 			[initialContentArea bounds]!

Item was added:
+ ----- Method: EventRecordingSpace>>controlsPanel (in category 'access') -----
+ controlsPanel
+ 	"Answer the controls panel."
+ 
+ 	^ controlsPanel!

Item was added:
+ ----- Method: EventRecordingSpace>>convertToCanonicalForm (in category 'processing') -----
+ convertToCanonicalForm
+ 	"In the canonical form, a content area origined at (0, 0) is established, and all event time-stamps are shifted such that 0 is the start of the tape."
+ 
+ 	| delta baseline |
+ 	self confirm: 'Caution: this is broken!!' translated orCancel: [^ self].
+ 
+ 	delta := contentArea topLeft negated.
+ 	baseline := eventRecorder tape first timeStamp.
+ 	eventRecorder tape:
+ 		(eventRecorder tape collect:
+ 			[:anEvent |
+ 				anEvent timeStamp: (anEvent timeStamp - baseline).
+ 				((anEvent isKindOf: MorphicUnknownEvent) and:
+ 						[anEvent type = #noteTheatreBounds]) ifTrue:
+ 					[anEvent argument: (0 at 0 extent: contentArea extent)].
+ 				anEvent translateBy: delta]).
+ 	initialContentArea position: 0 at 0!

Item was added:
+ ----- Method: EventRecordingSpace>>defersHaloToInterior (in category 'halo') -----
+ defersHaloToInterior
+ 	"Answer whether  when a halo-click goes down over some subobject within me, I should defer to it rather than seize the halo myself."
+ 
+ 	^ true!

Item was added:
+ ----- Method: EventRecordingSpace>>defersHaloToInteriorMorph: (in category 'halo') -----
+ defersHaloToInteriorMorph: aMorph
+ 	"Answer whether  when a halo-click goes down over some subobject within me, I should defer to it rather than seize the halo myself."
+ 
+ 	^ true!

Item was added:
+ ----- Method: EventRecordingSpace>>deleteOldVersions (in category 'processing') -----
+ deleteOldVersions
+ 	"Delete past versions remembered."
+ 
+ 	priorVersions := nil.
+ 	state ~= #readiyToRecord ifTrue: [self rememberCurrentRecording]!

Item was added:
+ ----- Method: EventRecordingSpace>>dismantlePaintBoxArtifacts (in category 'commands') -----
+ dismantlePaintBoxArtifacts
+ 	"Cleanup after playback -- if a paint-box has been left up, take it down."
+ 
+ 	(ActiveWorld findA: SketchEditorMorph) ifNotNilDo:
+ 		[:skEd | skEd cancelOutOfPainting]!

Item was added:
+ ----- Method: EventRecordingSpace>>editMenuButtonDefinition (in category 'menu') -----
+ editMenuButtonDefinition
+ 	"For debugging and development only!!  Open up a single-method browser on the method that defines the main menu of the receiver."
+ 
+ 	| mr |
+ 	mr _ MethodReference new setStandardClass: self class methodSymbol: #addMenuButtonItemsTo:.
+ 	self systemNavigation browseMessageList: {mr} name: 'Event Theatre menu Definition' translated autoSelect: nil!

Item was added:
+ ----- Method: EventRecordingSpace>>encouragesHaloTransferToEnclosedPasteUpMorph (in category 'processing') -----
+ encouragesHaloTransferToEnclosedPasteUpMorph
+ 	"Answer true, because a cmd-click on a submorph of a PasteUpMorph which itself is a submorph of mine should get the halo first."
+ 
+ 	^ true!

Item was added:
+ ----- Method: EventRecordingSpace>>escapeHitInEventRecorder (in category 'processing') -----
+ escapeHitInEventRecorder
+ 	"The user hit escape in the event recorder, to stop the recording..."
+ 
+ 	self state = #recording ifTrue: [^ self stopRecording].
+ 
+ 	self state = #playbackAddingVoiceover ifTrue:
+ 		[eventRecorder terminateVoiceRecording]. 
+ 
+ 	self state: #atEndOfPlayback.
+ 	self populateControlsPanel.
+ 	self borderColor: self color!

Item was added:
+ ----- Method: EventRecordingSpace>>eventRecorder (in category 'access') -----
+ eventRecorder
+ 	"Answer the receiver's eventRecorder."
+ 
+ 	^ eventRecorder!

Item was added:
+ ----- Method: EventRecordingSpace>>finalPicture (in category 'accessing') -----
+ finalPicture
+ 	"Answer the value of finalPicture"
+ 
+ 	^ finalPicture ifNil: [finalPicture := contentArea imageForm]!

Item was added:
+ ----- Method: EventRecordingSpace>>forgetPriorPaintBoxSettings (in category 'commands') -----
+ forgetPriorPaintBoxSettings
+ 	"Remove prior memory of paint box brush size and color from the initialContentArea"
+ 
+ 	initialContentArea removeProperty: #paintBoxBrushSymbol.
+ 	initialContentArea removeProperty: #paintBoxCurrentColor!

Item was added:
+ ----- Method: EventRecordingSpace>>handlesMouseDown: (in category 'events-processing') -----
+ handlesMouseDown: anEvent
+ 	"Watch for user clicking during playback"
+ 
+ 	(#(playback playbackAddingVoiceover) includes: state) ifFalse: [^ false].
+ 
+ 	^ (anEvent hand ~~ eventRecorder playHand "true for a real outside event") and:
+ 		[contentArea bounds containsPoint: anEvent position]!

Item was added:
+ ----- Method: EventRecordingSpace>>helpString (in category 'access') -----
+ helpString
+ 	"Answer a help string for the Event Theatre."
+ 
+ 	^ 'The Event Theatre provides a framework for authoring "event-movies".  It uses custom variants of the Navigator, the Supplies flap, the painting system, property sheets, Viewer flaps, etc., all of which reside within the controlled confines of the Theatre.
+ 
+ To author an event-movie, get a  new Event Theatre from the Objects catalog or from the "open..." branch of the desktop menu.
+ 
+ 1. Resize the Theatre, using the halo, to the delivery size desired for playback.
+ 
+ 2. Use the menu in the controls panel to add or delete Supplies and Navigator flaps as desired.
+ 
+ 3. Edit the "caption" by clicking on the text that says "Untitled" and typing your desired caption.  This caption is affixed to playback buttons, and, generally, provides a way to identify the event-movie.
+ 
+ 4. Set up the "initial conditions" for the event-movie you''re about to record (e.g., paint a background, provide some explanatory text, add objects you want to be present at the start of the movie.) When the recording is first opened by the user for playback, and whenever the recording has been rewound, this is exactly what it will look like.
+ 
+ 5. When ready to start the recording, press the "Record" button. A red border will be seen around the recorder, to indicate that recording is in progress.  Recording will continue until you hit the ESC key.
+ 
+ 6. Note that if you  want to include sound in your recording, you can add it directly during playback, or you can produce voiceover externally and add it in later using the Event Roll.
+ 
+ 7. Now proceed to "do", with the mouse and keyboard, whatever you wish to record.   For best results, all mouse gestures should be made within the interior of the Theatre.
+ 
+ 8. Hit ESC when done recording.
+ 
+ 9. To review what you''ve recorded, press "Play". If unhappy with the result, repeat steps 1-8.
+ 
+ 10.  If you''re happy with the result, and now wish to add a sound, open the sound panel, then click Play to replay the recording, and whenever you wish to add a snippet of voiceover, click on the "Start Recording Voiceover" button, and start talking, and when done with that snippet click the "Stop Recording Voiceover" button.  Once the playback finishes, the added voiceover(s) will become part of the event tape, and will be seen in the event roll.
+ 
+ 11. When you''re happy with the result, hit the "Publish" button, to get a playback button. There are currently two choices:
+ 
+ a. Iconic Button - Initially provides a picture of the initial scene of the movie, scaled 0.3x, and overlaid with the word HINT.  When the user clicks on such a button, the event-movie is played back in an ephemeral "playback theatre", and after the playback is done, the playback theatre shrinks down to a 0.5x scale-downed picture of the *final* scene of the movie.  Subsequent hitting of the button will again invoke a playback.
+ 
+ b. Textual Button - a simple labeled button which, when pressed, triggers playback of the event tape.
+ 
+ 12. The playback buttons you obtain when you "Publish" can be placed anywhere, such as on the page of a book. You can control, via a playback-button''s halo menu, whether or not it should be "auto-start", and whether or not "auto-dismiss". When the user presses the button, a "Playback" space will open, which resembles an Event Theatre, but has only playback-relevant controls.   A playback set up for both auto-start and auto-dismiss comes without any controls.
+ 
+ 13.  To edit the "event tape" of a recording you have made in an Event Theatre, and for a generally good time, click on the interlocking-circles icon to obtain a tool that allows you to visualize and to edit a "score" or "piano roll" of the event tape.
+ 
+ 
+ Summary of terms
+ 
+ Event Theatre
+   The main tool for creating an Event Tape.
+ 
+ Event Roll
+   An auxiliary tool showing the full "score" of an Event Tape. 
+ 
+ Event Tape
+   The results of an event-theatre session;  an interaction sequence that can be played back.
+ 
+ Event Recording
+   A term interchangeable with "Event Tape."
+ 
+ Event Movie
+   What you see when you play back an Event Tape.
+ 
+ ' translated!

Item was added:
+ ----- Method: EventRecordingSpace>>initialContentArea (in category 'processing') -----
+ initialContentArea
+ 	"Answer the initialContentArea, with the intent of copying it."
+ 
+ 	^ initialContentArea!

Item was added:
+ ----- Method: EventRecordingSpace>>initialPicture (in category 'accessing') -----
+ initialPicture
+ 	"Answer the value of initialPicture"
+ 
+ 	^ initialPicture!

Item was added:
+ ----- Method: EventRecordingSpace>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver to be a complete mentoring space"
+ 
+ 	super initialize.
+ 
+ 	eventRecorder := MentoringEventRecorder new.
+ 	eventRecorder recordingSpace: self.
+ 	self beSticky.
+ 	self listDirection: #topToBottom; hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ 	self extent: 1 at 1.
+ 	self borderWidth: 2; borderColor: Color gray.
+ 	self useRoundedCorners.
+ 	showingSoundPanel := false.
+ 
+ 	(contentArea _ Worldlet new)
+ 		setNameTo: 'tutorial';
+ 		color: Color white;
+ 		setProperty: #automaticPhraseExpansion toValue: true;
+ 		beSticky.
+ 
+ 	self addMorphBack: contentArea.
+ 
+ 	controlsPanel := AlignmentMorph newRow.
+ 	controlsPanel hResizing: #spaceFill.
+ 	controlsPanel  listCentering: #center. 
+ 	controlsPanel listSpacing: #equal.
+ 	controlsPanel cellInset: 4.
+ 	controlsPanel minHeight: 32.
+ 	self addMorphBack: controlsPanel.
+ 
+ 	soundPanel := AlignmentMorph newRow.
+ 	soundPanel hResizing: #spaceFill.
+ 	soundPanel  listCentering: #center. 
+ 	soundPanel listSpacing: #equal.
+ 	soundPanel cellInset: 4.
+ 	soundPanel minHeight: 32.
+ 	soundPanel color:  (Color r: 1.0 g: 0.839 b: 0.645).
+ 
+ 	self makeStatusButtons.
+ 	
+ 	state := #readyToRecord.
+ 	self populateControlsPanel.
+ 
+ 	SugarNavigatorBar showSugarNavigator
+ 		ifTrue:
+ 			[self addSugarNavigatorFlap]
+ 		ifFalse:
+ 			[self addSuppliesFlap.
+ 			self addNavigatorFlap]!

Item was added:
+ ----- Method: EventRecordingSpace>>initializeFromPlaybackButton: (in category 'initialization') -----
+ initializeFromPlaybackButton: anEventPlaybackButton
+ 	"Initialize my content area, caption, and tape from a playback button."
+ 
+ 	| soundEvent |
+ 	initialContentArea := anEventPlaybackButton contentArea veryDeepCopy.
+ 	eventRecorder tape: anEventPlaybackButton tape veryDeepCopy.
+ 	eventRecorder caption: anEventPlaybackButton  caption.
+ 	soundEvent := eventRecorder tape  detect: [:evt | evt 
+ type = #startSound] ifNone: [nil].
+ 	soundEvent ifNotNil:  "For benefit of possible re-record of voiceover"
+ 		[eventRecorder startSoundEvent: soundEvent].
+ 	initialPicture := anEventPlaybackButton initialPicture veryDeepCopy ifNil:
+ 		[self inform: 'caution - old playback; button lacks vital data.' translated.
+ 		^ nil].
+ 	finalPicture := anEventPlaybackButton finalPicture veryDeepCopy.
+ 	eventRecorder saved: true.
+ 
+ 	self rewind.
+ 	self center: ActiveWorld center
+ 	!

Item was added:
+ ----- Method: EventRecordingSpace>>inspectEventRecorder (in category 'commands') -----
+ inspectEventRecorder
+ 	"Inspect the event recorder."
+ 
+ 	eventRecorder inspect!

Item was added:
+ ----- Method: EventRecordingSpace>>inspectEventRoll (in category 'debugging') -----
+ inspectEventRoll
+ 	"Inspect the receiver's eventRoll"
+ 
+ 	eventRoll ifNotNil: [eventRoll inspectWithLabel: 'Event Roll for ' translated, self captionString] ifNil: [Beeper beep]!

Item was added:
+ ----- Method: EventRecordingSpace>>inspectEventTape (in category 'debugging') -----
+ inspectEventTape
+ 	"If there is an existing event tape, inspect it."
+ 
+ 	eventRecorder tape ifNotNil:
+ 		[eventRecorder tape inspectWithLabel: 'Event tape for ', self captionString]!

Item was added:
+ ----- Method: EventRecordingSpace>>inspectNavBar (in category 'sugar flaps') -----
+ inspectNavBar
+ 	"Debugging -- inspect a nav-bar if I have one."
+ 
+ 	| bar |
+ 	bar := self contentArea submorphs detect: [:m | m isKindOf: ProjectNavigationMorph] ifNone: [nil].
+ 	bar ifNotNil: [bar inspect]!

Item was added:
+ ----- Method: EventRecordingSpace>>inspectSoundRecorder (in category 'commands') -----
+ inspectSoundRecorder
+ 	"Inspect the sound recorder."
+ 
+ 	eventRecorder voiceRecorder inspect!

Item was added:
+ ----- Method: EventRecordingSpace>>installPaintBoxSettingsPrevailingAtRecordingTime (in category 'commands') -----
+ installPaintBoxSettingsPrevailingAtRecordingTime
+ 	"Install  settings for the PaintBox assumed by the recording, in preparation for playback.  But first save the existing values  for these settings, so that after playback the pre-existing state could be restored, though in current design we decide not to do that last."
+ 
+ 	self setProperty: #incomingPaintBoxBrushSymbol toValue: PaintBoxMorph prototype currentBrushSymbol.
+ 	self setProperty: #incomingPaintBoxCurrentColor toValue: PaintBoxMorph prototype getColor.
+ 
+ 	(contentArea valueOfProperty: #paintBoxBrushSymbol) ifNotNilDo:
+ 		[:sym |
+ 			PaintBoxMorph prototype brush: sym].
+ 
+ 	(contentArea valueOfProperty: #paintBoxCurrentColor) ifNotNilDo:
+ 		[:aColor |
+ 			PaintBoxMorph prototype currentColor: aColor]!

Item was added:
+ ----- Method: EventRecordingSpace>>justTornOffFromPartsBin (in category 'initialization') -----
+ justTornOffFromPartsBin
+ 	"A notification that the receiver was just torn off from a supplies flap, objects catalogue, or other parts factory; intercept this message to put up a help flap, for example."
+ 
+ 	"self putUpHelpFlap"!

Item was added:
+ ----- Method: EventRecordingSpace>>makeHorizontalRoll (in category 'commands') -----
+ makeHorizontalRoll
+ 	"Create a horizontal roll viewer for this recording space"
+ 
+ 	state = #readyToRecord ifTrue:
+ 		[^ self inform: 'Nothing recorded yet' translated].
+ 
+ 	"self convertToCanonicalForm." "Would prefer to do this but there are still issues."
+ 
+ 	eventRoll ifNil:
+ 		[eventRoll := (Smalltalk at: #EventRollMorph ifAbsent: [^ self notYetImplemented]) new.
+ 		eventRoll eventTheatre: self].
+ 
+ 	eventRoll formulate.
+ 
+ 	eventRoll isInWorld
+ 		ifFalse:
+ 			[eventRoll openInWorld.
+ 			eventRoll setExtentFromHalo: (ActiveWorld  width - 10) @ eventRoll height.
+ 			eventRoll top: self bottom.
+ 			eventRoll bottom: (eventRoll bottom min: ActiveWorld bottom).
+ 			eventRoll left: ActiveWorld left + 2]  "presumably zero"
+ 		ifTrue:
+ 			[eventRoll comeToFront]
+ 
+ !

Item was added:
+ ----- Method: EventRecordingSpace>>makeStatusButtons (in category 'initialization') -----
+ makeStatusButtons
+ 	"Build, but do not insert, the buttons that control"
+ 
+ 	publishButton := self buttonWithLabel: 'Publish' actionSelector: #publishButtonHit balloonText: 'When you hit this, you will be handed a button which, when it is clicked, will open up an Event Player in which the recording can be played back.' translated.
+ 
+ 	abandonButton := self tanOButton.
+ 	abandonButton actionSelector: #abandon.
+ 	abandonButton  setBalloonText: 'Abandon this effort and throw away this window' translated.
+ 
+ 	recordButton := self buttonWithLabel: 'Record' translated actionSelector: #record balloonText: 'Start Recording' translated.
+ 
+ 	menuButton := self menuButton.
+ 	"self buttonWithLabel: 'Options' translated actionSelector: #offerMenu balloonText: 'Offers a menu of options'."
+ 
+ 	scriptButton :=  IconicButton new target: self;
+ 		borderWidth: 0;
+ 		labelGraphic: (ScriptingSystem formAtKey: #Script);
+ 		color: Color transparent; 
+ 		actWhen: #buttonUp;
+ 		actionSelector: #makeHorizontalRoll;
+ 		setBalloonText: 'show this theatre''s script in a piano-roll-like format for visualizaitoin and editing.' translated;
+ 		yourself.
+ 
+ 	recordAgainButton := self buttonWithLabel: 'Record Again' translated actionSelector: #recordAgain balloonText: 'Abandon existing recording and start a new one.' translated.
+ 
+ 	recordVoiceoverButton := self buttonWithLabel: 'Start Recording Voiceover' translated actionSelector: #recordVoiceover balloonText: 'Add a voiceover to the existing event-recorded sequence ' translated.
+ 
+ 	stopRecordingVoiceoverButton := self buttonWithLabel: 'Stop Record Voiceover' translated actionSelector: #stopRecordingVoiceover balloonText: nil  " 'Stop the recording of the voiceover segment currently being recorded' translated ".
+ 
+ 	playButton := self buttonWithLabel: 'Play' translated actionSelector: #play balloonText: 'Replay this sequence' translated.
+ 
+ 	rewindButton := self buttonWithLabel: 'Rewind' translated actionSelector: #rewind balloonText: 'Reset to the starting condition for this recording' translated.
+ 
+ 	stopButton := self buttonWithLabel: 'Stop' translated actionSelector: #stopPlayback balloonText: 'Stop playing or recording this panel' translated.
+ 
+ 	pauseButton := self buttonWithLabel: 'Pause' translated actionSelector: #pausePlayback balloonText: 'Temporarily pause this playback' translated.
+ 
+ 	resumeButton := self buttonWithLabel: 'Resume' translated actionSelector: #resumePlayback balloonText: 'Resume playback' translated.
+ 
+ 	captionMorph := UpdatingStringMorph contents: self captionString font: ScriptingSystem fontForTiles.
+ 	captionMorph useStringFormat.
+ 	captionMorph target: self.
+ 	captionMorph getSelector: #captionString; putSelector: #captionString:; growable: true; minimumWidth: 48.
+ 
+ 	showingSoundButton := UpdatingThreePhaseButtonMorph blackTriangularOpener.
+ 	showingSoundButton
+ 		target: self;
+ 		actionSelector: #toggleShowingSoundPanel;
+ 		getSelector: #notShowingSoundPanel.
+ 	showingSoundButton setBalloonText: 'show/hide voice controls' translated
+ 
+ 
+ 
+ !

Item was added:
+ ----- Method: EventRecordingSpace>>mouseDown: (in category 'events-processing') -----
+ mouseDown: evt
+ 	
+ 	(eventRecorder userStopReplayMaybe: evt) ifTrue: [self stopPlayback]. 
+ 	^ super mouseDown: evt.
+ 	!

Item was added:
+ ----- Method: EventRecordingSpace>>mouseDownPriority (in category 'events-processing') -----
+ mouseDownPriority
+ 	"High so we can stop playback, but we do not mark it as handled, so others can run too."
+ 
+ 	^ (#(playback playbackAddingVoiceover) includes: state)
+ 		ifTrue:
+ 			[110]
+ 		ifFalse:
+ 			[0]!

Item was added:
+ ----- Method: EventRecordingSpace>>navigatorFlapOrNil (in category 'flaps') -----
+ navigatorFlapOrNil
+ 	"If the receiver has an existing navigator flap, answer it, else answer nil"
+ 
+ 	^ contentArea submorphs detect: [:aMorph | (aMorph isKindOf: FlapTab) and: [aMorph flapID = 'Navigator']] ifNone: [nil]!

Item was added:
+ ----- Method: EventRecordingSpace>>notShowingSoundPanel (in category 'accessing') -----
+ notShowingSoundPanel
+ 	"Answer the opposite of the value of showingSoundPanel"
+ 
+ 	^ showingSoundPanel not!

Item was added:
+ ----- Method: EventRecordingSpace>>offerMenu (in category 'menu') -----
+ offerMenu
+ 	"A menu button was hit.  Offer a menu of options for the receiver."
+ 
+ 	| aMenu |
+ 	aMenu _ MenuMorph new defaultTarget: self.
+ 	self addMenuButtonItemsTo: aMenu.
+ 	aMenu popUpInWorld!

Item was added:
+ ----- Method: EventRecordingSpace>>offerVersions (in category 'menu') -----
+ offerVersions
+ 	"Offer the user the opportunity to revert to a prior version of a recorded event tape."
+ 
+ 	| aList aMenu |
+ 	aList := self priorVersions collect: [:v | v first].
+ 	aList ifEmpty: [^ self inform:  'no versions available, sorry' translated].
+ 	aMenu := MenuMorph new defaultTarget: self.
+ 	aMenu addTitle: 'Choose a version to restore' translated.
+ 	aList do:
+ 		[:el | aMenu add: el printString selector: #restoreVersionStamped: argument: el].
+ 	aMenu popUpInWorld!

Item was added:
+ ----- Method: EventRecordingSpace>>openTextualPlaybackButton (in category 'processing') -----
+ openTextualPlaybackButton
+ 	"Open a textual playback button that will play the receiver."
+ 
+ 	| aButton |
+ 	aButton := PlaybackInvoker new initializeFrom: self.
+ 	aButton showString: self captionString.
+ 	self  publishPlaybackButton: aButton!

Item was added:
+ ----- Method: EventRecordingSpace>>openUnhintedPlaybackButton (in category 'processing') -----
+ openUnhintedPlaybackButton
+ 	"Open a playback button without the HINT overlay."
+ 
+ 	self publishPlaybackButton:  (PlaybackInvoker new initializeFrom: self)!

Item was added:
+ ----- Method: EventRecordingSpace>>parseEventTape (in category 'debugging') -----
+ parseEventTape
+ 	"Parse the event tape; open an Inspector on the derivative tape."
+ 
+ 	| aParser parserClass |
+ 	eventRecorder tape ifNil: [^ self inform: 'nothing recorded yet' translated].
+ 	
+ 	parserClass := Smalltalk at: #EventTapeParser ifAbsent: [^ Beeper beep].
+ 	aParser := parserClass new eventTape: eventRecorder tape.
+ 	aParser parseTape.
+ 	aParser newTape inspectWithLabel: 'Parsed Tape - ', Time now printString!

Item was added:
+ ----- Method: EventRecordingSpace>>pausePlayback (in category 'commands') -----
+ pausePlayback
+ 	 "Pause the playback.  Sender responsible for setting state to #suspendedPlayback"
+ 
+ 	eventRecorder pausePlayback.
+ 	(ActiveWorld findA: SketchEditorMorph) ifNotNilDo:
+ 		[:skEd | skEd cancelOutOfPainting.
+ 		^ self rewind].
+ 	self borderColor: Color orange.
+ 	self setProperty: #suspendedContentArea toValue: contentArea veryDeepCopy.
+ 	self populateControlsPanel!

Item was added:
+ ----- Method: EventRecordingSpace>>play (in category 'processing') -----
+ play
+ 	"Play the tape once."
+ 
+ 	eventRecorder ifNotNil:
+ 		[self comeToFront.
+ 		self restoreInitialContentArea.
+ 		self installPaintBoxSettingsPrevailingAtRecordingTime.
+ 		self abandonReplayHandsAndHalos.
+ 		self state: #playback.
+ 		eventRecorder play]
+ 
+ 	!

Item was added:
+ ----- Method: EventRecordingSpace>>playingEnded (in category 'processing') -----
+ playingEnded
+ 	"The playback reached the end."
+ 
+ 	| snippetsList |
+ 	self state: #atEndOfPlayback.
+ 	snippetsList := eventRecorder valueOfProperty: #snippetsList.
+ 	snippetsList isEmptyOrNil ifFalse:
+ 		[snippetsList do:
+ 			[:soundEvent |
+ 				eventRecorder mergeMediaEvent: soundEvent].
+ 		self pushEventTapeToEventRoll ].
+ 	eventRecorder removeProperty: #snippetsList.
+ 
+ 	self populateControlsPanel.
+ 	self borderColor: self color.
+ 	self abandonReplayHandsAndHalos.
+ 	self removeProperty: #suspendedContentArea.
+ 	self refreshRoll.
+ 	self removeAlarm: #offerTickingMenu:  "in case timing unlucky."
+ !

Item was added:
+ ----- Method: EventRecordingSpace>>populateControlsPanel (in category 'processing') -----
+ populateControlsPanel
+ 	"Build the things that need to be in the controls panel."
+ 
+ 	| neverRecorded aMorph existing |
+ 	scriptButton ifNil: [self makeStatusButtons].
+ 
+ 	existing := contentArea topLeft.
+ 	controlsPanel removeAllMorphs.
+ 	soundPanel removeAllMorphs.
+ 	soundPanel addVariableTransparentSpacer.
+ 	self populateSoundPanel.
+ 
+ 	(#(recording recordingWithSound) includes: self state) ifTrue:
+ 		[controlsPanel  addVariableTransparentSpacer.
+ 		 aMorph := StringMorph contents: 'Hit ESC to stop recording' translated font: (StrikeFont familyName:  'Accujen' size: 24).
+ 		self addControlWithSpacer: aMorph.
+ 		^ self assureContentAreaStaysAt:  existing].
+ 
+ 	(#(playback playbackAddingVoiceover) includes: self state) ifTrue:
+ 		[self addControlWithSpacer: captionMorph lock.
+ 		self addControlWithSpacer:  pauseButton.
+ 		self addControlWithSpacer: stopButton.
+ 		 ^ self assureContentAreaStaysAt: existing].
+ 
+ 	controlsPanel  addTransparentSpacerOfSize: 6 at 0.
+ 	controlsPanel addMorphBack: abandonButton.
+ 	controlsPanel addTransparentSpacerOfSize: 12 at 0.
+ 	controlsPanel addMorphBack: self helpButton.
+ 	controlsPanel addTransparentSpacerOfSize: 12 at 0.
+ 	controlsPanel addMorphBack: menuButton.
+ 
+ 	controlsPanel  addVariableTransparentSpacer.
+ 	neverRecorded := state = #readyToRecord.
+ 	neverRecorded ifFalse:
+ 		[self addControlWithSpacer: publishButton.
+ 		self addControlWithSpacer: scriptButton].
+ 
+ 	self addControlWithSpacer: captionMorph unlock.
+ 
+ 	neverRecorded
+ 		ifTrue:
+ 			[self addControlWithSpacer: recordButton]
+ 		ifFalse:
+ 			[self addControlWithSpacer: recordAgainButton].
+ 
+ 
+ 	state = #playback ifTrue: [self addControlWithSpacer: stopButton].
+ 	state == #suspendedPlayback ifTrue:
+ 		[self addControlWithSpacer: resumeButton].
+ 
+ 	neverRecorded ifFalse: [self addControlWithSpacer: rewindButton].
+ 
+ 	(#(rewound atEndOfPlayback) includes: self state) ifTrue:
+ 		[self addControlWithSpacer: playButton].
+ 	controlsPanel addVariableTransparentSpacer.
+ 	controlsPanel addMorphBack: showingSoundButton.
+ 	controlsPanel addTransparentSpacerOfSize: 6 at 0.
+ 	self assureContentAreaStaysAt:  existing
+ !

Item was added:
+ ----- Method: EventRecordingSpace>>populateSoundPanel (in category 'processing') -----
+ populateSoundPanel
+ 	"Like de selector say."
+ 
+ 	| rec levelSlider meterBox voiceControls sliderWrapper |
+ 	(#( playbackAddingVoiceover) includes: self state) ifTrue:
+ 		[self  addToSoundPanelWithSpacer: stopRecordingVoiceoverButton].
+ 
+ 	(#(playback) includes: self state) ifTrue:
+ 		[self addToSoundPanelWithSpacer: recordVoiceoverButton].
+ 
+ 	rec := eventRecorder assuredVoiceRecorder.
+ 	voiceControls := AlignmentMorph newColumn.
+ 	voiceControls hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 0.
+ 	voiceControls setNameTo: 'voice controls'.
+ 	levelSlider _ SimpleSliderMorph new
+ 		color: color;
+ 		extent: 60 at 2;
+ 		target: rec;
+ 		setNameTo: 'level control';
+ 		actionSelector: #recordLevel:;
+ 		adjustToValue: rec recordLevel.
+ 	
+ 	sliderWrapper _ AlignmentMorph newRow
+ 		color: color;
+ 		layoutInset: 0;
+ 		wrapCentering: #center; cellPositioning: #leftCenter;
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #rigid;
+ 		height: 8.
+ 	sliderWrapper addMorphBack: (StringMorph contents: '0 ' font: (StrikeFont familyName: 'Accujen' size: 10)).
+ 	sliderWrapper addMorphBack: levelSlider.
+ 	sliderWrapper addMorphBack: (StringMorph contents: ' 10' font: (StrikeFont familyName: 'Accujen' size: 10)).
+ 	voiceControls addMorphBack: sliderWrapper.
+ 
+ 	meterBox _ Morph new extent: 82 at 8; color: Color gray.
+ 	eventRecorder recordMeter height: 8.
+ 	meterBox addMorph: eventRecorder recordMeter.
+ 	eventRecorder recordMeter position: meterBox position.
+ 
+ 	voiceControls addMorphBack: meterBox.
+ 	meterBox setNameTo: 'meter box'.
+ 
+ 	self addToSoundPanelWithSpacer: voiceControls
+ !

Item was added:
+ ----- Method: EventRecordingSpace>>possiblyAddVoiceControlsToControlPanel (in category 'processing') -----
+ possiblyAddVoiceControlsToControlPanel
+ 	"Like de selector say."
+ 
+ 	| rec levelSlider meterBox voiceControls sliderWrapper |
+ 	(rec := eventRecorder voiceRecorder) ifNil: [^ self].
+ 	voiceControls := AlignmentMorph newColumn.
+ 	voiceControls hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 0.
+ 	voiceControls setNameTo: 'voice controls'.
+ 	levelSlider _ SimpleSliderMorph new
+ 		color: color;
+ 		extent: 60 at 2;
+ 		target: rec;
+ 		setNameTo: 'level control';
+ 		actionSelector: #recordLevel:;
+ 		adjustToValue: rec recordLevel.
+ 	
+ 	sliderWrapper _ AlignmentMorph newRow
+ 		color: color;
+ 		layoutInset: 0;
+ 		wrapCentering: #center; cellPositioning: #leftCenter;
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #rigid;
+ 		height: 8.
+ 	sliderWrapper addMorphBack: (StringMorph contents: '0 ' font: (StrikeFont familyName: 'Accujen' size: 10)).
+ 	sliderWrapper addMorphBack: levelSlider.
+ 	sliderWrapper addMorphBack: (StringMorph contents: ' 10' font: (StrikeFont familyName: 'Accujen' size: 10)).
+ 	voiceControls addMorphBack: sliderWrapper.
+ 
+ 	meterBox _ Morph new extent: 82 at 8; color: Color gray.
+ 	eventRecorder recordMeter height: 8.
+ 	meterBox addMorph: eventRecorder recordMeter.
+ 	eventRecorder recordMeter position: meterBox position.
+ 
+ 	voiceControls addMorphBack: meterBox.
+ 	meterBox setNameTo: 'meter box'.
+ 
+ 	self addToSoundPanelWithSpacer: voiceControls
+ !

Item was added:
+ ----- Method: EventRecordingSpace>>presentHelp (in category 'commands') -----
+ presentHelp
+ 	"Sent when a Help button is hit; provide the user with some form of help for the tool at hand"
+ 
+ 	| aFlapTab |
+ 	aFlapTab := ScriptingSystem assureFlapOfLabel: 'Event Theatre' translated withContents: self helpString.
+ 	aFlapTab showFlap!

Item was added:
+ ----- Method: EventRecordingSpace>>priorVersions (in category 'access') -----
+ priorVersions
+ 	"Answer a list of (<time stamp> recordingSpace) pairs representing prior versions of the recording."
+ 
+ 	^ priorVersions ifNil: [priorVersions := OrderedCollection new]!

Item was added:
+ ----- Method: EventRecordingSpace>>priorVersions: (in category 'access') -----
+ priorVersions: pv
+ 	"Set the priorVersions - used during restoration"
+ 
+ 	^ priorVersions := pv!

Item was added:
+ ----- Method: EventRecordingSpace>>publishButtonHit (in category 'processing') -----
+ publishButtonHit
+ 	"Hand the user a button which, when hit, will open a playback window on the content of the receiver as currently constituted."
+ 
+ 	| aMenu |
+ 	aMenu := MenuMorph new defaultTarget: self.
+ 	aMenu addTranslatedList:  #(
+ 		('Iconic button' openUnhintedPlaybackButton)
+ 		('Textual button' openTextualPlaybackButton)) translatedNoop.
+ 
+ 	aMenu center:  publishButton center; openInWorld!

Item was added:
+ ----- Method: EventRecordingSpace>>publishPlaybackButton: (in category 'processing') -----
+ publishPlaybackButton: aButton
+ 	"Given a playback button, depending on the setting of the #dismissEventTheatreUponPublish preference, either:
+ 	[a]  Dismiss the event thetre, and put the button at topleft of screen, or
+ 	[b]  Leave the event theatre up, and 'hand' the user the button."
+ 
+ 	eventRecorder saved: true.
+ 	Preferences dismissEventTheatreUponPublish
+ 		ifTrue:
+ 			[aButton openNearTopLeftOfScreen.
+ 			self abandon]
+ 		ifFalse:
+ 			[aButton openInHand]!

Item was added:
+ ----- Method: EventRecordingSpace>>pushEventTapeToEventRoll (in category 'commands') -----
+ pushEventTapeToEventRoll
+ 	"If I have an eventRoll, push my revised tape to it."
+ 
+ 	eventRoll ifNotNil:
+ 		[eventRoll acceptTape: eventRecorder tape.
+ 		eventRoll formulate]!

Item was added:
+ ----- Method: EventRecordingSpace>>putUpHelpFlap (in category 'initialization') -----
+ putUpHelpFlap
+ 	"If appropriate, put up (if not alredy present) a flap giving documentation"
+ 
+ 	(ScriptingSystem assureFlapOfLabel: 'Event Theatre' withContents: self helpString)
+ 		hideFlap
+ !

Item was added:
+ ----- Method: EventRecordingSpace>>record (in category 'commands') -----
+ record
+ 	"Commence event recording..."
+ 
+ 	ActiveWorld abandonAllHalos.
+ 	self comeToFront.
+ 	
+ 	initialContentArea := contentArea veryDeepCopy.
+ 	self forgetPriorPaintBoxSettings.
+ 	initialPicture := contentArea imageForm.
+ 	self state: #recording.
+ 	self borderColor: Color red.
+ 	self populateControlsPanel.
+ 	ActiveWorld doOneCycleNow.
+ 
+ 	eventRecorder record!

Item was added:
+ ----- Method: EventRecordingSpace>>recordAgain (in category 'commands') -----
+ recordAgain
+ 	"There is already a recording; abandon it and make a fresh recording."
+ 
+ 	self record!

Item was added:
+ ----- Method: EventRecordingSpace>>recordVoiceover (in category 'commands') -----
+ recordVoiceover
+ 	"During playback, or alongside initial recording, record a voiceover"
+ 
+ 	| newState |
+ 	self comeToFront.
+ 	
+ 	newState := self state = #recording
+ 		ifTrue:
+ 			[#recordingWithSound]
+ 		ifFalse:
+ 			[#playbackAddingVoiceover].
+ 	self state: newState.
+ 	
+ 	eventRecorder startRecordingNewSound.
+ 
+ 	self populateControlsPanel.
+ 	newState = #playbackAddingVoiceover ifTrue: [self borderColor: Color blue]
+ !

Item was added:
+ ----- Method: EventRecordingSpace>>refreshRoll (in category 'commands') -----
+ refreshRoll
+ 	"If there is an event-roll [script] affiliated with the receiver, refresh it."
+ 
+ 	eventRoll ifNotNil: [eventRoll updateCursorFromRecordingSpace]!

Item was added:
+ ----- Method: EventRecordingSpace>>rememberCurrentRecording (in category 'commands') -----
+ rememberCurrentRecording
+ 	"Remember the current state of the receiver as a version."
+ 
+ 	| priors newEntry |
+ 	priors := self priorVersions.
+ 	priorVersions := OrderedCollection new.
+ 	newEntry := Array with: Time dateAndTimeNow with: self veryDeepCopy.
+ 	priorVersions := priors copyWith: newEntry!

Item was added:
+ ----- Method: EventRecordingSpace>>rememberPaintBoxSettingsAtRecordingOutset (in category 'commands') -----
+ rememberPaintBoxSettingsAtRecordingOutset
+ 	"If this is the first such call in a recording session, make a note of the brush-size and current-color settings of the PaintBoxMorph prototype at the outset of recording.  These are preserved as properties of the contentArea, so that they will travel with playback buttons affiliated with it."
+ 
+ 	(initialContentArea hasProperty: #paintBoxBrushSymbol) ifFalse:
+ 		[initialContentArea setProperty: #paintBoxBrushSymbol toValue: PaintBoxMorph prototype currentBrushSymbol.
+ 		initialContentArea setProperty: #paintBoxCurrentColor toValue: PaintBoxMorph prototype getColor]!

Item was added:
+ ----- Method: EventRecordingSpace>>removeEventRoll (in category 'event roll') -----
+ removeEventRoll
+ 	"Abandon any existing event roll for the receiver."
+ 
+ 	eventRoll ifNotNil: [eventRoll delete].
+ 	eventRoll := nil!

Item was added:
+ ----- Method: EventRecordingSpace>>removeNavigatorFlap (in category 'flaps') -----
+ removeNavigatorFlap
+ 	"Remove a navigator flap if there is none."
+ 
+ 	| existing |
+ 	existing := contentArea submorphs detect: [:aMorph | (aMorph isKindOf: FlapTab) and: [aMorph flapID = 'Navigator']] ifNone: [nil].
+ 	existing ifNotNil: [existing dismissViaHalo]!

Item was added:
+ ----- Method: EventRecordingSpace>>removeSugarNavigatorFlap (in category 'sugar flaps') -----
+ removeSugarNavigatorFlap
+ 	"Hide the fake interior sugar navigator."
+ 
+ 	(contentArea findA: InteriorSugarNavBar) ifNotNilDo:
+ 		[:aBar | aBar delete]!

Item was added:
+ ----- Method: EventRecordingSpace>>removeSuppliesFlap (in category 'flaps') -----
+ removeSuppliesFlap
+ 	"Remove a navigator flap if there is none."
+ 
+ 	| existing |
+ 	existing := contentArea submorphs detect: [:aMorph | (aMorph isKindOf: FlapTab) and: [aMorph flapID = 'Supplies']] ifNone: [nil].
+ 	existing ifNotNil: [existing dismissViaHalo]!

Item was added:
+ ----- Method: EventRecordingSpace>>restoreIncomingPaintBoxSettings (in category 'commands') -----
+ restoreIncomingPaintBoxSettings
+ 	"After a playback, restore the current-brush-width and current-color settings that had prevailed before playback started.  Only current sender has its call to this method commented out, however..."
+ 
+ 	(self valueOfProperty: #incomingPaintBoxBrushSymbol) ifNotNilDo:
+ 		[:sym | PaintBoxMorph prototype brush: sym.
+ 		self removeProperty: #incomingPaintBoxBrushSymbol].
+ 
+ 	(self valueOfProperty: #incomingPaintBoxCurrentColor) ifNotNilDo:
+ 		[:aColor | PaintBoxMorph prototype currentColor: aColor.
+ 		self removeProperty:  #incomingPaintBoxCurrentColor]!

Item was added:
+ ----- Method: EventRecordingSpace>>restoreInitialContentArea (in category 'processing') -----
+ restoreInitialContentArea
+ 	"Restore the initial content area."
+ 
+ 	| existingPosition |
+ 	initialContentArea ifNil:  "Never recorded, so the baseline is an empty content area"
+ 		[contentArea removeAllMorphs.
+ 		self addNavigatorFlap.
+ 		self addSuppliesFlap.
+ 		self populateControlsPanel.
+ 		^ self].
+  
+ 	existingPosition := contentArea position.
+ 	contentArea ifNotNil: [contentArea delete].
+ 	self addMorphFront: (contentArea := initialContentArea veryDeepCopy).
+ 	contentArea position: existingPosition.
+ 
+ 	eventRecorder noteAreaBounds.
+ 	eventRecorder findPlayOffset
+ !

Item was added:
+ ----- Method: EventRecordingSpace>>restoreVersionStamped: (in category 'processing') -----
+ restoreVersionStamped: aStamp
+ 	"Restore the receiver to its state preserved under the given time-stamp."
+ 
+ 	| rollShowing foundPair eventTheatre revisedPriorVersions |
+ 	rollShowing := eventRoll notNil and: [eventRoll isInWorld].
+ 	rollShowing ifTrue: [eventRoll delete].
+ 	foundPair := self priorVersions detect: [:pair | pair first = aStamp] ifNone: [^ self error: 'version lost'].
+ 
+ 	self delete.
+ 	eventTheatre := foundPair second veryDeepCopy.
+ 	revisedPriorVersions := (priorVersions copyWithout: foundPair) copyWith: foundPair.
+ 	eventTheatre priorVersions: revisedPriorVersions.
+ 	eventTheatre openInWorld.
+ 	eventTheatre removeEventRoll.
+ 	rollShowing ifTrue: [eventTheatre makeHorizontalRoll]
+ 	
+ 	!

Item was added:
+ ----- Method: EventRecordingSpace>>resumePlayback (in category 'commands') -----
+ resumePlayback
+ 	"Resume a suspended playback."
+ 
+ 	self comeToFront.
+ 	contentArea  delete.
+ 	contentArea := (self valueOfProperty: #suspendedContentArea) .
+ 	self addMorphFront: contentArea.
+ 	eventRecorder synchronize.
+ 	self state: #playback.
+ 	eventRecorder playHand  suspended: false.
+ 	self populateControlsPanel.
+ 	self borderColor: Color gray.!

Item was added:
+ ----- Method: EventRecordingSpace>>rewind (in category 'commands') -----
+ rewind
+ 	"Rewind the tape, as it were, after a recording or playback."
+ 
+ 	self restoreInitialContentArea.
+ 	self abandonReplayHandsAndHalos.
+ 	eventRecorder noteRewound.
+ 	self state: #rewound.
+ 	self populateControlsPanel.
+ 	self refreshRoll!

Item was added:
+ ----- Method: EventRecordingSpace>>setBalloonHelp (in category 'commands') -----
+ setBalloonHelp
+ 	"Allow the user to edit the balloon-help string to be used for playback buttons."
+ 
+ 	| reply aString |
+ 	aString := 
+ 	reply _ FillInTheBlank
+ 		multiLineRequest: 'Edit the balloon help to be supplied for playback buttons made for this event movie' translated
+ 		centerAt: Sensor cursorPoint
+ 		initialAnswer: (aString ifNil: [self noHelpString] ifNotNil: [aString])
+ 		answerHeight: 200.
+ 	reply ifNil: [^ self].  "User cancelled out of the dialog"
+ 	(reply isEmpty or: [reply asString = self noHelpString])
+ 		ifTrue: [self balloonHelpString: nil]
+ 		ifFalse: [self balloonHelpString: reply]!

Item was added:
+ ----- Method: EventRecordingSpace>>setCaption (in category 'commands') -----
+ setCaption
+ 	"Interactively supply the caption,.  Not currently called, as its entry in the tool's menu is for the moment commented out..."
+ 
+ 	| aCaption aResult |
+ 	eventRecorder ifNil: [^ self].
+ 	aCaption := eventRecorder caption ifNil: ['Your Title Goes Here' translated].
+ 	aResult := FillInTheBlank request: 'Please edit the caption' translated initialAnswer: aCaption.
+ 	aResult isEmptyOrNil ifFalse:
+ 		[eventRecorder caption: aResult.
+ 		captionMorph contents: aResult]
+ 		!

Item was added:
+ ----- Method: EventRecordingSpace>>setExtentFromHalo: (in category 'halo') -----
+ setExtentFromHalo: anExtent
+ 	"The user has dragged the grow box such that the receiver's extent would be anExtent.  Do what's needed."
+ 
+ 	contentArea width: anExtent x.
+ 	contentArea height: (anExtent y - (self innerBounds height - contentArea height)).!

Item was added:
+ ----- Method: EventRecordingSpace>>shrinkTape (in category 'commands') -----
+ shrinkTape
+ 	"If I have a tape, shrink it."
+ 
+ 	state = #readyToRecord ifTrue:
+ 		[^ self inform: 'nothing recorded yet' translated].
+ 
+ 	eventRecorder shrink.
+ 	self rememberCurrentRecording.
+ 	self pushEventTapeToEventRoll!

Item was added:
+ ----- Method: EventRecordingSpace>>state (in category 'access') -----
+ state
+ 	"Answer the state."
+ 
+ 	^ state!

Item was added:
+ ----- Method: EventRecordingSpace>>state: (in category 'access') -----
+ state: aState
+ 	"Set the receiver's state, with no side effects."
+ 
+ 	state := aState!

Item was added:
+ ----- Method: EventRecordingSpace>>step (in category 'processing') -----
+ step
+ 	"Periodic stepping."
+ 
+ 	super step.
+ 	eventRecorder step "So record meter gets updated"!

Item was added:
+ ----- Method: EventRecordingSpace>>stop (in category 'commands') -----
+ stop
+ 	"Stop recording or playing the event recorder."
+ 
+ 	eventRecorder ifNotNil: [eventRecorder stop].
+ 	self refreshRoll!

Item was added:
+ ----- Method: EventRecordingSpace>>stopPlayback (in category 'commands') -----
+ stopPlayback
+ 	"Stop the playback on the event recorder."
+ 
+ 	eventRecorder stop.
+ 	self playingEnded!

Item was added:
+ ----- Method: EventRecordingSpace>>stopRecording (in category 'commands') -----
+ stopRecording
+ 	"Make the event-recorder stop recording"
+ 
+ 	eventRecorder stop.
+ 	finalPicture := contentArea imageForm.
+ 
+ 	self state: #atEndOfPlayback.
+ 	self populateControlsPanel.
+ 	self borderColor: self color.
+ 
+ 	self rememberCurrentRecording.
+ 
+ 	self pushEventTapeToEventRoll!

Item was added:
+ ----- Method: EventRecordingSpace>>stopRecordingVoiceover (in category 'commands') -----
+ stopRecordingVoiceover
+ 	"The user has hit the button asking to stop recording voiceover."
+ 
+ 	eventRecorder terminateVoiceRecording.
+ 	self state = #playbackAddingVoiceover ifTrue:
+ 		[self state: #playback].
+ 	self populateControlsPanel
+ 
+ 	
+ 
+ 	!

Item was added:
+ ----- Method: EventRecordingSpace>>sugarNavBarOrNil (in category 'flaps') -----
+ sugarNavBarOrNil
+ 	"If I have a fake-sugar-nav-bar, answer it, else answer nil."
+ 
+ 	^ contentArea submorphs detect: [:aMorph | aMorph isKindOf: InteriorSugarNavBar] ifNone: [nil]!

Item was added:
+ ----- Method: EventRecordingSpace>>sugarNavigatorFlapOrNil (in category 'flaps') -----
+ sugarNavigatorFlapOrNil
+ 	"If the receiver has an existing sugar navigator flap, answer it, else answer nil"
+ 
+ 	^ contentArea submorphs detect: [:aMorph | aMorph isKindOf: InteriorSugarNavBar] ifNone: [nil]!

Item was added:
+ ----- Method: EventRecordingSpace>>sugarPartsBinQuads (in category 'sugar flaps') -----
+ sugarPartsBinQuads
+ 	"Answer definitions for the contents of the supplies bin within the sugar-nav-bar of the event theatre."
+ 
+ 	^  {
+ 	{#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	. #authoringPrototype. '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}.
+ 	{#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}.
+ 	{#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' 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}.
+ 	{#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A button to use with tile scripting; its script will be a method of its containing playfield' translatedNoop}.
+ 	{#SimpleSliderMorph.	#authoringPrototype.	'Slider' translatedNoop.	'A slider for showing and setting numeric values.' translatedNoop}
+ }
+ asOrderedCollection!

Item was added:
+ ----- Method: EventRecordingSpace>>sugarSuppliesFlapTab (in category 'sugar flaps') -----
+ sugarSuppliesFlapTab
+ 	"Build and answer an interior sugar-supplies flap"
+ 
+ 	|  aFlapTab aStrip quads |
+ 	quads := self sugarPartsBinQuads.
+ 	aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color gray muchLighter from: quads withPreviousEntries: #().
+ 	Flaps twiddleSuppliesButtonsIn: aStrip.
+ 	aFlapTab _ InteriorSolidSugarSuppliesTab new referent: aStrip beSticky.
+ 	aFlapTab sugarNavBar: self sugarNavBarOrNil.
+ 	aFlapTab setName: 'Supplies' translated edge: #top color: Color red lighter.
+ 	aFlapTab position: (contentArea topLeft + (0 @ SugarNavTab new height)).
+ 	aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
+ 	aFlapTab applyThickness: 20.
+ 
+ 	aStrip extent: contentArea width @ (76 * (1 + (1350 // contentArea width))).
+ 	aStrip beFlap: true.
+ 	aStrip autoLineLayout: true.
+ 	aFlapTab useSolidTab.
+ 	aFlapTab height: 20; color:  (Color r: 0.804 g: 0.804 b: 0.804).
+ 
+ 	^ aFlapTab!

Item was added:
+ ----- Method: EventRecordingSpace>>suppliesFlapOrNil (in category 'flaps') -----
+ suppliesFlapOrNil
+ 	"If the receiver has an existing supplies flap, answer it, else answer nil"
+ 
+ 	^ contentArea submorphs detect: [:aMorph | (aMorph isKindOf: FlapTab) and: [aMorph flapID = 'Supplies']] ifNone: [nil]!

Item was added:
+ ----- Method: EventRecordingSpace>>toggleShowingSoundPanel (in category 'commands') -----
+ toggleShowingSoundPanel
+ 	"Toggle whether showing the sound panel."
+ 
+ 	showingSoundPanel := (showingSoundPanel ~~ false) not.  "bkwd compat"
+ 	showingSoundPanel 
+ 		ifFalse:
+ 			[soundPanel delete]
+ 		ifTrue:
+ 			[self addMorphBack: soundPanel]!

Item was added:
+ ----- Method: EventRecordingSpace>>toggleUsingVoice (in category 'menu') -----
+ toggleUsingVoice
+ 	"Toggle whether or not using voice."
+ 
+ 	eventRecorder voiceRecorder
+ 		ifNil:
+ 			[eventRecorder addVoiceControls]
+ 		ifNotNil:
+ 			[eventRecorder deleteVoiceControls].
+ 	self populateControlsPanel!

Item was added:
+ ----- Method: EventRecordingSpace>>usingVoice (in category 'menu') -----
+ usingVoice
+ 	"Answer whether voice is enbled"
+ 
+ 	^ eventRecorder voiceRecorder notNil!

Item was added:
+ ----- Method: EventRecordingSpace>>usingVoiceString (in category 'menu') -----
+ usingVoiceString
+ 	"Answer a string characterizing whether voice is being used or not."
+ 
+ 	^ (eventRecorder voiceRecorder
+ 		ifNil: ['<no>'] ifNotNil: ['<yes>']), 'record voice during event recording' translated!

Item was added:
+ ProjectNavigationMorph subclass: #EventRecordingSpaceNavigator
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Navigators'!
+ 
+ !EventRecordingSpaceNavigator commentStamp: 'sw 10/11/2006 03:41' prior: 0!
+ A custom navigator to use within the content area of an EventRecordingSpace.!

Item was added:
+ ----- Method: EventRecordingSpaceNavigator>>doNewPainting (in category 'the actions') -----
+ doNewPainting
+ 	"Make a new painting"
+ 
+ 	| worldlet |
+ 	ActiveWorld assureNotPaintingElse: [^ self].
+ 	worldlet _ self ownerThatIsA: Worldlet.
+ 	worldlet closeNavigatorFlap.
+ 	worldlet makeNewDrawing: (ActiveHand lastEvent copy setPosition: worldlet center)!

Item was added:
+ Morph subclass: #EventRollCursor
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !EventRollCursor commentStamp: 'sw 12/24/2006 17:08' prior: 0!
+ A Morph serving as the cursor on an EventTimeline in an EventRoll.
+ At present, there is no real benefit to having a separate class for the cursor, since it has no unique behavior yet.   However, in the future we may wish for the cursor to be more dynamic, and this gives us a way in for doing things like that.!

Item was added:
+ ----- Method: EventRollCursor>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver."
+ 
+ 	super initialize.
+ 	self color: Color red.
+ 	self width: 1.
+ 	self beSticky!

Item was added:
+ AlignmentMorph subclass: #EventRollMorph
+ 	instanceVariableNames: 'startTime millisecondsPerPixel totalDuration eventTheatre rawEventTape mouseTrack keyboardTrack mediaTrack actualRoll eventPlaybackCursor'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !EventRollMorph commentStamp: 'sw 11/24/2006 04:40' prior: 0!
+ A tool used in conjunction with an event-recording-space to view and edit events in an event score.!

Item was added:
+ ----- Method: EventRollMorph>>abandon (in category 'processing') -----
+ abandon
+ 	"Forget any memory of this event roll, and dismiss it.  When/if an event-roll is later requested from my event theatre, a fresh one will be launched."
+ 
+ 	eventTheatre ifNotNil: [eventTheatre removeEventRoll].
+ 	self delete!

Item was added:
+ ----- Method: EventRollMorph>>acceptTape: (in category 'initialization') -----
+ acceptTape: aTape
+ 	"Accept a new event tape; this will rebuild everything."
+ 
+ 	| aParser |
+ 	rawEventTape :=  aTape.
+ 	startTime := rawEventTape first timeStamp.
+ 	aParser := EventTapeParser new.
+ 	aParser eventTape: rawEventTape.
+ 	aParser parseTape.
+ 	mouseTrack := aParser mouseTrack.
+ 	keyboardTrack := aParser keyboardTrack.
+ 	mediaTrack := aParser ambientTrack select: [:t | t isKindOf: MediaPlayEvent].
+ 	totalDuration := self computeTotalDuration
+ 
+ 
+ !

Item was added:
+ ----- Method: EventRollMorph>>addCustomMenuItems:hand: (in category 'menus') -----
+ addCustomMenuItems: aMenu hand: aHandMorph
+ 	"Add morph-specific  items to the halo menu."
+ 
+ 	super addCustomMenuItems: aMenu hand: aHandMorph.
+ 	aMenu addTranslatedList: #(
+ 		('change scale...' changeScale   'allows you to supply a precise scale-factor manually.')
+ 		('retrofit to event-theatre' pushChangesBackToEventTheatre   'normally not necessary, but if you suspect that edits you have made in this event roll have not been fully appreciated by the event theatre, choose this to force the event theatre to reflect what you see in the event roll.' )) translatedNoop!

Item was added:
+ ----- Method: EventRollMorph>>addMenuButtonItemsTo: (in category 'display') -----
+ addMenuButtonItemsTo: aMenu
+ 	"Add menu items to the menu obtained by clicking on the menu icon"
+ 
+ 	"CAUTION:  Debugging items still present."
+ 
+ 	aMenu addTitle: 'Event-Roll Options' translated.
+ 
+ 	aMenu addTranslatedList: #(
+ 		('revert to version...'  offerVersions 'allows you to back up to any earlier version of the event tape.') ) translatedNoop.
+ 
+ 	Preferences debugging ifTrue:
+ 		[aMenu addTranslatedList: #(
+ 		-
+ 
+ 	"	('change scale...' changeScale   'allows you to supply a precise scale-factor manualliy.')
+ 		('retrofit to event-theatre' pushChangesBackToEventTheatre  'normally not necessary, but if you suspect that edits you have made in this event roll have not been fully appreciated by the event theatre, choose this to force the event theatre to reflect what you see in the event roll.' )
+ 		-
+ 		('restore original event theatre'	restoreOriginalEventTheatre  'Restore the event theatre, and hence this event roll, to how they were when you first made this roll.')
+ 		-"
+ 		('inspect event roll' inspect  'debugging -- open an Inspector on this event roll')
+ 		('update cursor' updateCursorFromRecordingSpace 'debugging -- update the red roll cursor')
+ 		('update scrollbar' updateScrollbar  'debugging -- update the scrollbar')
+ 		-
+ 		('edit this menu' editMenuButtonDefinition 'debugging -- change the definition of this menu.')) translatedNoop]!

Item was added:
+ ----- Method: EventRollMorph>>changeScale (in category 'processing') -----
+ changeScale
+ 	"Let the user reconsider the scale.  Normally, we expect the user to change the scale using the scale slider, but the earlier feature embodied here, which allows the user to type in the desired new scale, is, for the moment at least, retained."
+ 
+ 	| result |
+ 	result := FillInTheBlank request: 'Milliseconds per pixel [currently ' translated, millisecondsPerPixel printString, ']' initialAnswer: millisecondsPerPixel printString.
+ 
+ 	(result isEmptyOrNil not and: [result asNumber ~= millisecondsPerPixel]) ifTrue:
+ 		[self establishScale: result asNumber]!

Item was added:
+ ----- Method: EventRollMorph>>colorForButtons: (in category 'initialization') -----
+ colorForButtons: anInteger
+ 	"Answer a color to use to encode the button configuration"
+ 
+ 	(#(1 65) includes: anInteger) ifTrue: [^ Color blue lighter].
+ 	(#(2 34) includes: anInteger) ifTrue: [^ Color yellow lighter].
+ 	anInteger = 4 ifTrue: [^ Color red lighter].
+ 
+ 	"Need to flesh this out "
+ 	^ Color green lighter!

Item was added:
+ ----- Method: EventRollMorph>>computeTotalDuration (in category 'processing') -----
+ computeTotalDuration
+ 	"Answer the total duration of the events in my current raw event tape, in miliseconds, in a sledgehammer fashion.  Because of the slowness of this, the result is cached in my totalDuration inst var. "
+ 
+ 	| baseline total |
+ 	total := 0.
+ 	baseline := rawEventTape first timeStamp.
+ 	rawEventTape do:
+ 		[:evt |
+ 			evt type = #noCondense ifFalse: "annoying non-cooperator!!"
+ 				[total := total max: (evt timeStamp + evt durationInMilliseconds - baseline)]].
+ 	^ total!

Item was added:
+ ----- Method: EventRollMorph>>establishScale: (in category 'processing') -----
+ establishScale: msPerPixel
+ 	"Establish the number provided as the millisecondsPerPixel."
+ 
+ 	millisecondsPerPixel := ((msPerPixel asNumber rounded) max: 1) min: 50.
+ 	self formulate!

Item was added:
+ ----- Method: EventRollMorph>>eventTheatre (in category 'accessing') -----
+ eventTheatre
+ 	"Answer the value of eventTheatre"
+ 
+ 	^ eventTheatre!

Item was added:
+ ----- Method: EventRollMorph>>eventTheatre: (in category 'initialization') -----
+ eventTheatre: anEventTheatre
+ 	"Establish the eventTheatre for an EventRoll."
+ 
+ 	eventTheatre := anEventTheatre.
+ 	self acceptTape: anEventTheatre eventRecorder tape.
+ 
+ 	"(ScriptingSystem assureFlapOfLabel: 'Event Roll' translated withContents: self helpString translated) hideFlap"
+ 
+ !

Item was added:
+ ----- Method: EventRollMorph>>formulate (in category 'processing') -----
+ formulate
+ 	"Given that all my relevant inst vars are now filled,build the structures that constitute the tool."
+ 
+ 		"Replace the parts of the tool that change"
+ 
+ 	| outer scrollAreaWidth |
+ 	submorphs size  > 1
+ 		ifFalse:
+ 			[scrollAreaWidth := 600]
+ 		ifTrue:
+ 			[scrollAreaWidth := submorphs second width].
+ 
+ 	[submorphs size > 1] whileTrue: [submorphs last delete].
+ 
+ 	actualRoll := EventTimeline new extent: ( (self totalDuration / millisecondsPerPixel) @ 160).
+ 	actualRoll color: Color yellow muchLighter.
+ 	actualRoll beSticky.
+ 	outer := ScrollPane new extent: scrollAreaWidth @ 160.
+ 	outer model: self.
+ 	outer useRoundedCorners.
+ 	outer scrollBarOnLeft: false.
+ 	outer scroller addMorph: actualRoll.
+ 	outer retractable: false.
+ 	outer hideVScrollBarIndefinitely: true.
+ 	outer alwaysShowHScrollBar: true.
+ 
+ 	self addMorphBack: outer.
+ 
+ 	self setMouseEventMorphs.
+ 	self setKeyboardEventMorphs.
+ 	self setMediaEventMorphs.
+ 	self setTimeIndicators.
+ 
+ 	actualRoll addMorphFront: eventPlaybackCursor.
+ 	eventPlaybackCursor  bounds: (actualRoll topLeft extent: (2 @ actualRoll height)).
+ 
+ 	self setVerticalGrid: (1000/millisecondsPerPixel)  rounded  backgroundColor: Color blue veryMuchLighter lineColor: Color gray darker.
+ 	
+ 	self updateScrollbar!

Item was added:
+ ----- Method: EventRollMorph>>helpString (in category 'documentation') -----
+ helpString
+ 	"Answer a help string for the Event Roll."
+ 
+ 	^ 'An Event Roll is a used to visualize and edit the score, or "tape", of an Event Theatre''s "event movie".
+ 
+ The Roll shows three "tracks", one for all Mouse events, one for Keyboard events, and one for all other events, such as sound.
+ 
+ You can *remove* any item from an event roll by just picking it up with the mouse and dropping it anywhere outside the roll (such as on the desktop or in the trash-can.)  If in doubt about the effect of removing an item, you can put it on the desktop, play the revised tape, then pick up the event from the desktop and drop it back near where you found it in the event roll, and replay again to compare.
+ 
+ You can *reposition* any item in an event roll by picking it up with the mouse and dropping it anywhere else in the roll.  CAUTION:  Items in the mouse-event track should not be dropped such that they overlap -- see caveat below under "Tips".
+ 
+ You can drag various kinds of items *into* the roll.  For example, you can drop a "Morph" or a "Tile" obtained from a SoundRecorder, and you can drop a "button" representing another event-recorded sequence (though it is not at the moment recommended to do the latter.)  One straightforward way of adding voiceovers to an existing event recording is to play back the recording while selectively making individual snippets of voice recordings using a separate, standard Squeak SoundRecording tool.  After you are satisfied with a recording, obtain a "morph" from the sound-recording tool, and position it as desired in the event roll.
+ 
+ You can *resize* items in the "mouse" track of an event roll.  When you stretch or shrink a mouse-sequence, the events within the sequence get remapped linearly within the duration represented by the new size of the sequence as seen in the event roll.  [CAUTION:  Do not resize a mouse item such that it will overlap an adjacent one.  It is a bug that this is even allowed.]
+ 
+ In addition to adding separately-recorded voiceovers using the mechanism described in item 3 above, there is a built-in voiceover mechanism in the Event Theatre.  Whenever you are playing back an existing event-recording in an Event Theatre, a "Record Voiceover" button will appear.  If you press this, the playback of the event recording will continue and you can record a voiceover to go with any portion you wish.  When you are done recording a snippet, you can hit the "stop recording voiceover" button; playback will continue, and you can subsequently, on this pass or any future one, add more voiceover snippets.  To remove a voiceover snippet, simply drag it out of the event roll; to reposition it, simply pick it up with the mouse and drop it back into the event roll at the desired position.
+ 
+ When you make a change in an Event Roll, it will immediately change the tape of the Event Theatre, so that when you replay the event-movie you will immediately see see the change.  If you are unhappy with the change, there is a one-level "undo" available which will revert the EventTheatre to its state before the last edit you made in the EventRoll.  There is also a "deeper" level of "undo" available that will revert the EventTheatre (and hence the associated EventRoll) to the initial state they were in when you first launched the event roll.
+ 
+ 
+ Keyboard Track
+ 
+ You can reposition or delete any keyboard-track item.
+ 
+ Color conventions in the keyboard track: (These will change soon!!)
+ 
+ 	White	Simple lower-case character, no modifier key pressed
+ 	Red		Shift-key pressed
+ 	Green	Alt-key pressed
+ 	Yellow	Control-key pressed
+ 
+ 	Yellow	A "space" character
+ 	Blue		A "backspace" character
+ 
+ Unprintable characters are shown in red with the ascii value displayed, e.g. #13 for a "return" character.
+ 
+ *Important Tips*
+ 
+ (1)  To get the halo on an object inside an EventRoll, hold down the SHIFT key as you halo-click on the object.
+ 
+ (2)  DO NOT reposition or resize mouse-track items such that any two of them overlap, since this will result in the events represented by the two items getting co-mingled in such a way that they you will never be able to separate them again, and the mixture will have crazy results.  It is a bug that you are allowed to drop mouse-track items such that they overlap.  So please, DO NOT DO IT!!  If by accident you do, you might be interested in trying out some of the revert mechanisms in the system.
+ ' translated!

Item was added:
+ ----- Method: EventRollMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver."
+ 
+ 	super initialize.
+ 	self layoutInset: 0.
+ 	self color:  (Color r: 0.677 g: 0.839 b: 1.0).
+ 	self useRoundedCorners.
+ 	self listDirection: #leftToRight; hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 1 at 1.
+ 
+ 	millisecondsPerPixel := 10.
+ 
+ 	eventPlaybackCursor := EventRollCursor new.
+ 	self beSticky.
+ 	self makeControlsPanel!

Item was added:
+ ----- Method: EventRollMorph>>installChangedTapeToNewEventTheatre (in category 'processing') -----
+ installChangedTapeToNewEventTheatre
+ 	"Install the changed tape into a *new* eventTheatre."
+ 
+ 	self shouldBeImplemented!

Item was added:
+ ----- Method: EventRollMorph>>makeButtonsPanel (in category 'initialization') -----
+ makeButtonsPanel
+ 	"Answer a horizontal panel containing my control buttons."
+ 
+ 	| aBut buttons |
+ 	buttons := AlignmentMorph newRow beTransparent.
+ 	buttons hResizing: #spaceFill.
+ 	buttons  listCentering: #center. 
+ 	buttons listSpacing: #equal.
+ 	buttons cellInset: 2; layoutInset: 0.
+ 
+ 	buttons addVariableTransparentSpacer.
+ 	buttons addMorphBack: (aBut := self tanOButton).
+ 	aBut actionSelector: #abandon.
+ 	aBut setBalloonText: 'Abandon  this piano roll.  If you have made changes and wish them to be propagated back to the originating event-theatre, be sure to do that before abandoning the piano roll.' translated.
+ 
+ 	buttons addTransparentSpacerOfSize: (5 at 0).
+ 	buttons addMorphBack:  self helpButton.
+ 	buttons addTransparentSpacerOfSize: (5 at 0).
+ 
+ 	buttons addMorphBack: self menuButton.
+ 	buttons addTransparentSpacerOfSize: (5 at 0).
+ 
+ 	buttons addVariableTransparentSpacer.
+ 	^ buttons!

Item was added:
+ ----- Method: EventRollMorph>>makeControlsPanel (in category 'processing') -----
+ makeControlsPanel
+ 	"One-time initialization.  Upon entry, the receiver has no submorphs; upon exit, it has one, namely its controlsPanel, which contains the scale slider, the track headings, and the control buttons."
+ 
+ 	| topWrapper labelWrapper aMorph aPanel |
+ 	aPanel := AlignmentMorph newColumn beTransparent.
+ 	aPanel hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ 
+ 	topWrapper := AlignmentMorph newRow beTransparent.
+ 	topWrapper hResizing: #spaceFill; vResizing: #shirnkWrap.
+ 	topWrapper rubberBandCells: true.
+ 
+ 	labelWrapper := AlignmentMorph newColumn beTransparent.
+ 	labelWrapper addTransparentSpacerOfSize: 0 at 4.
+ 	#('mouse' 'keyboard' 'media') translatedNoop do:
+ 		[:aString |
+ 			aMorph := Morph new extent: 80@ 20.
+ 			aMorph hResizing: #rigid; vResizing: #rigid.
+ 			aMorph beTransparent.
+ 			aMorph addMorphCentered: (StringMorph contents: aString translated font: (StrikeFont familyName: 'Accujen' size: 24)).
+ 			labelWrapper addMorphBack: aMorph.
+ 			labelWrapper addTransparentSpacerOfSize: 0 at 20].
+ 	labelWrapper submorphs last delete.  "that last spacer"
+ 	topWrapper addMorphBack:  labelWrapper.
+ 	labelWrapper on: #mouseDown send: #grabMorph: to: self.
+ 
+ 	topWrapper addMorphBack: self scaleSlider.
+ 
+ 	aPanel addMorphBack: topWrapper.
+ 	aPanel addMorphBack: self makeButtonsPanel.
+ 	self addMorph: aPanel!

Item was added:
+ ----- Method: EventRollMorph>>millisecondsPerPixel (in category 'miscellaneous') -----
+ millisecondsPerPixel
+ 	"Answer the receiver's millisecondsPerPixel."
+ 
+ 	^ millisecondsPerPixel!

Item was added:
+ ----- Method: EventRollMorph>>offerVersions (in category 'processing') -----
+ offerVersions
+ 	"Let the user choose a prior version to which to revert."
+ 
+ 	eventTheatre offerVersions !

Item was added:
+ ----- Method: EventRollMorph>>pixelsPerSecond (in category 'accessing') -----
+ pixelsPerSecond
+ 	"Answer the number of pixels of the roll it takes to represent one second of real time."
+ 
+ 	^ 1000 // millisecondsPerPixel !

Item was added:
+ ----- Method: EventRollMorph>>pixelsPerSecond: (in category 'accessing') -----
+ pixelsPerSecond: aNumber
+ 	"Set the number of pixels per second."
+ 
+ 	self establishScale:  ((1.0 / aNumber) * 1000) rounded!

Item was added:
+ ----- Method: EventRollMorph>>presentHelp (in category 'documentation') -----
+ presentHelp
+ 	"Sent when a Help button is hit; provide the user with some form of help for the tool at hand"
+ 
+ 	| aFlapTab |
+ 	aFlapTab := ScriptingSystem assureFlapOfLabel: 'Event Roll' translated withContents: self helpString.
+ 	aFlapTab showFlap!

Item was added:
+ ----- Method: EventRollMorph>>pushChangesBackToEventTheatre (in category 'processing') -----
+ pushChangesBackToEventTheatre
+ 	"Push the event-tape changes implied by the user's edit in the event-roll back into the originating event theatre."
+ 
+ 	| allNewEvents newTape |
+ 	allNewEvents := Array streamContents:
+ 		[:aStream |
+ 			rawEventTape do:
+ 				[:e | (e isMemberOf: MorphicUnknownEvent) ifTrue:
+ 					[aStream nextPut: e]].   "Misc directives such as do not condense & worldlet bounds"
+ 
+ 			actualRoll submorphs do:
+ 				[:m |
+ 					m putEventsOnto: aStream]].
+ 					
+ 	newTape := allNewEvents asSortedCollection: [:a :b | a timeStamp < b timeStamp].
+ 	eventTheatre acceptNewTape: newTape.
+ 	self acceptTape: newTape.
+ 	self formulate!

Item was added:
+ ----- Method: EventRollMorph>>scaleSlider (in category 'processing') -----
+ scaleSlider
+ 	"Answer a device that can serve to govern the scale of the piano roll."
+ 
+ 	| aSlider |
+ 	aSlider _ SimpleSliderMorph new
+ 		color: Color blue muchLighter;
+ 		extent: 12 @ 120;
+ 		target: self;
+ 		minVal: 1;
+ 		maxVal: 50;
+ 		setNameTo: 'scale';
+ 		actionSelector: #establishScale:;
+ 		adjustToValue: millisecondsPerPixel.
+ 	^ aSlider
+ 	
+ !

Item was added:
+ ----- Method: EventRollMorph>>scrollPaneForRoll (in category 'accessing') -----
+ scrollPaneForRoll
+ 	"Answer the scrollPane that encompasses the roll."
+ 
+ 	^ submorphs second!

Item was added:
+ ----- Method: EventRollMorph>>setExtentFromHalo: (in category 'miscellaneous') -----
+ setExtentFromHalo: anExtent
+ 	"The user has dragged the grow box such that the receiver's extent would be anExtent.  Do what's needed."
+ 
+ 	submorphs second width: ((anExtent x - submorphs first width - 8))!

Item was added:
+ ----- Method: EventRollMorph>>setKeyboardEventMorphs (in category 'display') -----
+ setKeyboardEventMorphs
+ 	"Place morphs representing the keyboard track on the roll."
+ 
+ 	| aMorph aChar stroke report |
+ 	true ifTrue: [^ self setKeystrokeEventMorphs].
+ 
+ 	keyboardTrack do:
+ 		[:evt |
+ 			aMorph := KeyboardEventMorph new.
+ 			aMorph hResizing: #shrinkWrap.
+ 			aMorph vResizing: #shrinkWrap.
+ 			aMorph beTransparent.
+ 			aMorph event: evt.
+ 			aMorph extent: (evt duration / millisecondsPerPixel) @ 20.
+ 			aMorph left: ((evt startTime - startTime)/ millisecondsPerPixel).
+ 			aMorph top: 44.
+ 			stroke := evt events detect: [:event | event type = #keystroke]
+ 				ifNone: [nil].
+ 			aChar := stroke ifNotNil: [stroke keyCharacter] ifNil: [evt events first keyCharacter].	
+ 			report := (aChar tokenish or: [aChar isSpecial] or: [aChar = $ ])
+ 				ifTrue:
+ 					[aChar asString]
+ 				ifFalse:
+ 					['#', aChar asciiValue printString].
+ 
+ 			aMorph character: aChar.
+ 			aMorph addMorphCentered: (StringMorph contents: report font: (StrikeFont familyName: 'Accujen' size: 15)) lock.
+ 			actualRoll addMorphBack: aMorph]!

Item was added:
+ ----- Method: EventRollMorph>>setKeystrokeEventMorphs (in category 'display') -----
+ setKeystrokeEventMorphs
+ 	"Place morphs representing keystrokes into keyboard track on the roll."
+ 
+ 	| aMorph aChar report |
+ 	keyboardTrack do:
+ 		[:evt |
+ 			aMorph := KeyboardEventMorph new.
+ 			aMorph layoutPolicy: TableLayout new.
+ 			aMorph hResizing: #shrinkWrap.
+ 			aMorph vResizing: #shrinkWrap.
+ 			aMorph beTransparent.
+ 			aMorph event: evt.
+ 			aMorph left: ((evt timeStamp - startTime) / millisecondsPerPixel).
+ 		
+ 			aMorph top: 50.
+ 			aChar := evt keyCharacter.
+ 			report := (aChar tokenish or: [aChar isSpecial] or: [#($  $.) includes: aChar])
+ 				ifTrue:
+ 					[aChar asString]
+ 				ifFalse:
+ 					['#', aChar asciiValue printString].
+ 
+ 			aMorph character: aChar.
+ 			aMorph addMorphCentered: (StringMorph contents: report font: (StrikeFont familyName: 'Accujen' size: 24)) lock.
+ 			actualRoll addMorphBack: aMorph]!

Item was added:
+ ----- Method: EventRollMorph>>setMediaEventMorphs (in category 'display') -----
+ setMediaEventMorphs
+ 	"Place morphs representing the media track on the roll."
+ 
+ 	| aMorph aWheel |
+ 	mediaTrack ifEmpty: [^ self].
+ 	aWheel := Color wheel: mediaTrack size.
+ 	mediaTrack doWithIndex:
+ 		[:evt :index |
+ 			aMorph := MediaEventMorph new.
+ 			aMorph hResizing: #shrinkWrap.
+ 			aMorph vResizing: #shrinkWrap.
+ 			aMorph color: ((aWheel at: index) alpha: 0.5).
+ 			aMorph event: evt.
+ 			aMorph extent: ((evt durationInMilliseconds / millisecondsPerPixel) @ 32).
+ 			aMorph left: ((evt timeStamp - startTime)/ millisecondsPerPixel).
+ 			aMorph top: 84.
+ 			actualRoll addMorphBack: aMorph]!

Item was added:
+ ----- Method: EventRollMorph>>setMouseEventMorphs (in category 'display') -----
+ setMouseEventMorphs
+ 	"Place morphs representing the mouse track on the roll."
+ 
+ 	| aMorph aColor |
+ 	mouseTrack do:
+ 		[:evt |
+ 			aMorph := MouseEventSequenceMorph new.
+ 			aMorph event: evt.
+ 			aMorph extent: (evt duration / millisecondsPerPixel) @ 26.
+ 			aMorph left: ((evt startTime - startTime)/ millisecondsPerPixel).
+ 			aMorph top: 6.
+ 			aColor := evt events first type = #mouseMove
+ 				ifTrue:
+ 					[Color gray lighter]
+ 				ifFalse:
+ 					[self colorForButtons: evt events first buttons].
+ 			aMorph color: aColor.
+ 			actualRoll addMorphBack: aMorph.
+ 			"aMorph on: #doubleClick send: #openExpandedView: to: aMorph"]!

Item was added:
+ ----- Method: EventRollMorph>>setTimeIndicators (in category 'display') -----
+ setTimeIndicators
+ 	"Place morphs divulging elapsed time on the roll."
+ 
+ 	| aMorph outer |
+ 	 1 to: (self totalDuration // 1000) do:
+ 		[:sec |
+ 			aMorph := StringMorph contents: sec printString font: (StrikeFont familyName: 'Accujen' size: 32).
+ 			outer := RectangleMorph new.
+ 			outer extent: (aMorph extent + (1 at 1)).
+ 			outer borderWidth: 0.
+ 			outer color: (Color r: 0.903 g: 0.903 b: 1.0).
+ 			outer addMorphBack: aMorph.
+ 			aMorph center: outer center.
+ 			outer center:  ((sec * 1000) // millisecondsPerPixel) @ 128.
+ 			aMorph color: Color brown.
+ 			actualRoll addMorphBack: outer]!

Item was added:
+ ----- Method: EventRollMorph>>setVerticalGrid:backgroundColor:lineColor: (in category 'processing') -----
+ setVerticalGrid: anInteger backgroundColor: backColor lineColor: lineColor
+ 	"Make the receiver's color be an Infinite Form of repetitions of a form consisting of just a "
+ 
+ 	| gridForm |
+ 	gridForm := Form extent: anInteger @ anInteger depth: Display depth.
+ 	backColor ifNotNil: [gridForm fillWithColor: backColor].
+ 	gridForm fill: ((gridForm width -1) @0 extent: 1 @ gridForm height) fillColor: lineColor.
+ 
+ 	actualRoll color: (InfiniteForm with: gridForm)
+ !

Item was added:
+ ----- Method: EventRollMorph>>step (in category 'stepping') -----
+ step
+ 	"Periodic action... here, we update the cursor of the receiver's roll, and scroll the  current cursor's position in the roll into view if necessary."
+ 
+ 	(#(playback playbackAddingVoiceover) includes: eventTheatre state) ifTrue:
+ 		[self updateCursorFromRecordingSpace]
+ 		!

Item was added:
+ ----- Method: EventRollMorph>>stepTime (in category 'stepping') -----
+ stepTime
+ 	"Fast as I can."
+ 
+ 	^ 0!

Item was added:
+ ----- Method: EventRollMorph>>timeStampForCurrentPositionOf: (in category 'miscellaneous') -----
+ timeStampForCurrentPositionOf: anEventMorph
+ 	"Answer the time-stamp corresponding to the position of the left edge of the given eventMorph, assumed to be a submorph of my actual roll."
+ 
+ 	^ startTime + (anEventMorph left * millisecondsPerPixel)!

Item was added:
+ ----- Method: EventRollMorph>>timeStampForRightEdgeOf: (in category 'miscellaneous') -----
+ timeStampForRightEdgeOf: anEventMorph
+ 	"Answer the time-stamp corresponding to the position of the right edge of the given eventMorph, assumed to be a submorph of my actual roll."
+ 
+ 	^ startTime + (anEventMorph right * millisecondsPerPixel)!

Item was added:
+ ----- Method: EventRollMorph>>totalDuration (in category 'processing') -----
+ totalDuration
+ 	"Answer the total duration of the events in my current event tape, in miliseconds."
+ 
+ 	^ totalDuration ifNil: [totalDuration := self computeTotalDuration]!

Item was added:
+ ----- Method: EventRollMorph>>updateCursorFromRecordingSpace (in category 'processing') -----
+ updateCursorFromRecordingSpace
+ 	"Yup"
+ 
+ 	| cursorX aRect |
+ 	actualRoll ifNil: [^ self].
+ 	cursorX :=   ((eventTheatre eventRecorder millisecondsIntoPlayback ) // millisecondsPerPixel) min: (actualRoll width - 2).
+ 	aRect := cursorX @ 0 extent: 2 @ actualRoll height.
+ 	eventPlaybackCursor bounds:  aRect.
+ 	self scrollPaneForRoll scrollHorizontallyToShow: aRect!

Item was added:
+ ----- Method: EventRollMorph>>updateScrollbar (in category 'processing') -----
+ updateScrollbar
+ 	"Every subsystem needs a little bit of inscrutable magic.  Here it is for the event roll."
+ 
+ 	self setExtentFromHalo: (self extent + (33 at 0)).
+ 	self setExtentFromHalo: (self extent  +  (8 at 0))!

Item was added:
+ ----- Method: EventRollMorph>>wantsSteps (in category 'stepping') -----
+ wantsSteps
+ 	"Answer whether the receiver wants to be sent the #step message periodically."
+ 
+ 	^ true!

Item was added:
+ ----- Method: EventRollMorph>>wantsToBeDroppedInto: (in category 'drag and drop') -----
+ wantsToBeDroppedInto: aMorph
+ 	"Return true if it's okay to drop the receiver into aMorph."
+ 
+ 	^ aMorph isWorldMorph "only into worlds"!

Item was added:
+ ----- Method: EventSensor>>hasDandDEvents (in category '*Etoys-Squeakland-accessing') -----
+ hasDandDEvents
+ 	| found |
+ 	found := false.
+ 	eventQueue nextOrNilSuchThat: [:buf |
+ 		(self isDandDEvent: buf) ifTrue: [found := true].
+ 		false].
+ 	^found!

Item was added:
+ ----- Method: EventSensor>>isDandDEvent: (in category '*Etoys-Squeakland-private') -----
+ isDandDEvent: buf
+ 	^ (buf at: 1) = EventTypeDragDropFiles!

Item was added:
+ ----- Method: EventSensor>>swapControlAndAltKeys: (in category '*Etoys-Squeakland-private-I/O') -----
+ swapControlAndAltKeys: evt
+ 	| char |
+ 	char := evt at: 3.
+ 	"Cursor keys and mouse wheel are not switched."
+ 	(#(28 29 30 31) includes: char) ifTrue: [^ self].
+ 	(evt at: 5) == CtrlKeyBit
+ 		ifTrue: ["Ctrl -> Alt (^A -> a)"
+ 			char < 32 ifTrue: [#(3 6) do: [:ind | evt at: ind put: (char bitOr: 16r60)]].
+ 			evt at: 5 put: 8]
+ 		ifFalse: [(evt at: 5) == CommandKeyBit
+ 			ifTrue: ["Alt -> Ctrl (a -> ^A)"
+ 				(char >= 16r60 and:  [char < 16r80]) ifTrue: [#(3 6) do: [:ind | evt at: ind put: (char bitAnd: 16r1F)]].
+ 				evt at: 5 put: 2]].!

Item was added:
+ MorphicEvent subclass: #EventSequence
+ 	instanceVariableNames: 'startTime stopTime events'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !EventSequence commentStamp: 'sw 11/26/2006 03:12' prior: 0!
+ A kind of pseudo-morphic-event, created by aggregating all the events contributing to a  mouse-down/mouse-move/mouse-up sequence, or to a  sequence of all mouse-moves with no button down.    The startTime is the time stamp of the first actual event in the sequence; the stopTime is the time stamp of the last actual event in the sequence; and the #events inst var holds the actual events as obtained from the event tape.!

Item was added:
+ ----- Method: EventSequence>>addEvent: (in category 'processing') -----
+ addEvent: evt
+ 	"Add an event to my event-list."
+ 
+ 	events add: evt!

Item was added:
+ ----- Method: EventSequence>>duration (in category 'accessing') -----
+ duration
+ 	"Answer how long the event lasts, in milliseconds.  If no stopTime has yet been established, answer zero."
+ 
+ 	^ (stopTime ifNil: [startTime]) - startTime!

Item was added:
+ ----- Method: EventSequence>>durationInMilliseconds (in category 'accessing') -----
+ durationInMilliseconds
+ 	"Answer the duration of the activity represented by the receiver, in milliseconds."
+ 
+ 	^ self duration!

Item was added:
+ ----- Method: EventSequence>>events (in category 'accessing') -----
+ events
+ 	"Answer my events."
+ 
+ 	^ events!

Item was added:
+ ----- Method: EventSequence>>expandOnto: (in category 'processing') -----
+ expandOnto: aStream
+ 	"Place all the receiver's events onto a Stream"
+ 
+ 	aStream nextPutAll: events!

Item was added:
+ ----- Method: EventSequence>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver."
+ 
+ 	super initialize.
+ 	events := OrderedCollection new!

Item was added:
+ ----- Method: EventSequence>>position (in category 'accessing') -----
+ position
+ 	"Answer the position of the receiver."
+ 
+ 	^ events first position!

Item was added:
+ ----- Method: EventSequence>>printOn: (in category 'debugging') -----
+ printOn: aStream
+ 	"Print the receiver on a stream."
+ 
+ 	aStream nextPutAll: self class name, ': duration: ', (self duration printString), 'ms  ', events first type, ' -> ', events last type, ' total events ', (events size printString)!

Item was added:
+ ----- Method: EventSequence>>sequenceComplete (in category 'processing') -----
+ sequenceComplete
+ 	"The sequence is now complete; note the stop time."
+ 
+ 	stopTime := events last timeStamp!

Item was added:
+ ----- Method: EventSequence>>startTime (in category 'accessing') -----
+ startTime
+ 	"Answer the value of startTime."
+ 
+ 	^ startTime!

Item was added:
+ ----- Method: EventSequence>>startTime: (in category 'accessing') -----
+ startTime: anObject
+ 	"Set the value of startTime."
+ 
+ 	startTime _ anObject!

Item was added:
+ ----- Method: EventSequence>>stopTime: (in category 'accessing') -----
+ stopTime: anObject
+ 	"Set the value of stopTime."
+ 
+ 	stopTime _ anObject!

Item was added:
+ ----- Method: EventSequence>>timeStamp (in category 'accessing') -----
+ timeStamp
+ 	"Answer the timeStamp of the receiver."
+ 
+ 	^ startTime!

Item was added:
+ Object subclass: #EventTapeParser
+ 	instanceVariableNames: 'eventTape newTape currentMouseSequence currentKeyboardSequence'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !EventTapeParser commentStamp: 'sw 11/9/2006 03:55' prior: 0!
+ Preliminary, exploratory!!  Given a raw eventTape created by the EventRecorder, parse it into a new tape in which coherent mouse sequences are factored into higher-order events.!

Item was added:
+ ----- Method: EventTapeParser class>>executableEventTapeFromCompactTape: (in category 'services') -----
+ executableEventTapeFromCompactTape: aCompactEventTape
+ 	"Formulate a full fresh event tape from the given compact event tape."
+ 
+ 	| allEvents |
+ 	allEvents := Array streamContents:
+ 		[:aStream |
+ 			aCompactEventTape do:
+ 				[:anEvent |
+ 					anEvent expandOnto: aStream]].
+ 	^ (allEvents asSortedCollection: [:a :b | a timeStamp < b timeStamp]) asArray!

Item was added:
+ ----- Method: EventTapeParser>>ambientTrack (in category 'accessing') -----
+ ambientTrack
+ 	"Answer an array of MouseEpisodeEvents characterizing the mouse track."
+ 
+ 	^ newTape reject: [:p | p isKindOf: EventSequence orOf: KeyboardEventMorph]!

Item was added:
+ ----- Method: EventTapeParser>>concludeCurrentKeyboardSequence (in category 'accessing') -----
+ concludeCurrentKeyboardSequence
+ 	"If I have a keyboard sequence abuilding, finish it off.  This path not currently in use; for the moment we are only cherry-picking keystroke events."
+ 
+ 	currentKeyboardSequence ifNil: [^ self].
+ 	currentKeyboardSequence sequenceComplete.
+ 	newTape add: currentKeyboardSequence.
+ 	currentKeyboardSequence := nil!

Item was added:
+ ----- Method: EventTapeParser>>concludeCurrentMouseSequence (in category 'accessing') -----
+ concludeCurrentMouseSequence
+ 	"If I have a mouse sequence abuilding, finish it off."
+ 
+ 	currentMouseSequence ifNil: [^ self].
+ 	currentMouseSequence sequenceComplete.
+ 	newTape add: currentMouseSequence.
+ 	currentMouseSequence := nil!

Item was added:
+ ----- Method: EventTapeParser>>eventTape: (in category 'accessing') -----
+ eventTape: anObject
+ 	"Set the value of eventTape"
+ 
+ 	eventTape _ anObject!

Item was added:
+ ----- Method: EventTapeParser>>keyboardTrack (in category 'accessing') -----
+ keyboardTrack
+ 	"Answer an array of KeyboardeEventSequences characterizing the keyboard track."
+ 
+ 	self parseTape.
+ 	^ Array streamContents: [:aStream |
+ 		newTape do:
+ 			[:anEvent | anEvent addKeystrokeEventsTo: aStream]]!

Item was added:
+ ----- Method: EventTapeParser>>mouseTrack (in category 'accessing') -----
+ mouseTrack
+ 	"Answer an array of MouseEpisodeEvents characterizing the mouse track."
+ 
+ 	self parseTape.
+ 	^ newTape select: [:p | p isKindOf: MouseEventSequence]!

Item was added:
+ ----- Method: EventTapeParser>>newTape (in category 'accessing') -----
+ newTape
+ 	"Answer the value of newTape"
+ 
+ 	^ newTape!

Item was added:
+ ----- Method: EventTapeParser>>parseTape (in category 'accessing') -----
+ parseTape
+ 	"Parse the existing event-tape into a new tape of higher-level events."
+ 
+ 	| itsType  |
+ 	newTape := OrderedCollection new.
+ 	currentMouseSequence := nil.
+ 	currentKeyboardSequence := nil.
+ 	eventTape do:
+ 		[:anEvent | anEvent isMouse
+ 			ifTrue:
+ 				[(itsType := anEvent type) = #mouseDown
+ 					ifTrue:
+ 						[self concludeCurrentMouseSequence.
+ 						self startNewMouseSequenceWith: anEvent]
+ 					ifFalse:
+ 						[itsType = #mouseUp
+ 							ifTrue:
+ 								[currentMouseSequence
+ 									ifNil:
+ 										[Transcript cr; show:  'no mouse seq']
+ 									ifNotNil:
+ 										[currentMouseSequence addEvent: anEvent.
+ 										self concludeCurrentMouseSequence]]
+ 							ifFalse:
+ 								[currentMouseSequence
+ 									ifNil:
+ 										[self startNewMouseSequenceWith: anEvent]
+ 									ifNotNil:
+ 										[currentMouseSequence addEvent: anEvent]]]]
+ 			ifFalse:
+ 				[(anEvent isKeyboard not or: [anEvent type = #keystroke])
+ 					ifTrue:
+ 						[newTape add: anEvent]]]
+ !

Item was added:
+ ----- Method: EventTapeParser>>startNewKeyboardSequenceWith: (in category 'accessing') -----
+ startNewKeyboardSequenceWith: anEvent
+ 	"Start a new currentKeyboardeSequence, using the event provided as the first event in it.  Not currently in use... for the moment we only cherry-pick keystroke events.  Thus this method presently has no senders."
+ 
+ 	currentKeyboardSequence := KeyboardEventSequence new.
+ 	currentKeyboardSequence startTime: anEvent timeStamp.
+ 	currentKeyboardSequence addEvent: anEvent!

Item was added:
+ ----- Method: EventTapeParser>>startNewMouseSequenceWith: (in category 'accessing') -----
+ startNewMouseSequenceWith: anEvent
+ 	"Start a new currentMouseSequence, using the event provided as the first event in it"
+ 
+ 	currentMouseSequence := MouseEventSequence new.
+ 	currentMouseSequence startTime: anEvent timeStamp.
+ 	currentMouseSequence addEvent: anEvent!

Item was added:
+ PasteUpMorph subclass: #EventTimeline
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !EventTimeline commentStamp: 'sw 12/21/2006 22:30' prior: 0!
+ An EventTimeline is the scrollable surface on which the events are laid out in the EventRoll.!

Item was added:
+ ----- Method: EventTimeline>>acceptDroppingMorph:event: (in category 'dropping/grabbing') -----
+ acceptDroppingMorph: aMorph event: evt
+ 	"Accept the drop of a morph."
+ 
+ 	| aRect anEventRoll itsDuration itsWidthAfterDrop |
+ 	self flag: #deferred.  "This is a possible place for discovering whether the drop would have damaging effects on the mouse track..."
+ 
+ 	(aMorph isKindOf: MouseEventSequenceMorph)
+ 		ifTrue:
+ 			[itsDuration := aMorph durationInMilliseconds.
+ 			itsWidthAfterDrop := itsDuration // self eventRoll millisecondsPerPixel.
+ 			super acceptDroppingMorph: aMorph event: evt.
+ 			aMorph bounds: ((aMorph left @ 6) extent: (itsWidthAfterDrop @ aMorph height)).
+ 			submorphs do:
+ 				[:m |
+ 					((m ~~ aMorph) and: [m isKindOf: MouseEventSequenceMorph])
+ 						ifTrue:
+ 							[(m bounds intersects: aMorph bounds)
+ 								ifTrue:
+ 									["Eureka"
+ 									aMorph delete.
+ 									aMorph position: 100 at 100.
+ 									aMorph openInWorld.
+ 									aMorph flash.
+ 									^ self]]]]
+ 		ifFalse:
+ 			[super acceptDroppingMorph: aMorph event: evt]
+ .
+ 	aRect := (((aMorph left + 10) max: 10) @ 0) extent: 100@ 10.
+ 
+ 	(anEventRoll  := self eventRoll) pushChangesBackToEventTheatre.  "Note that will ultimately result in replacement of the receiver by a new timeline"
+ 	aMorph delete.
+ 	ActiveWorld abandonAllHalos.
+ 	anEventRoll scrollPaneForRoll scrollHorizontallyToShow: aRect
+ !

Item was added:
+ ----- Method: EventTimeline>>defaultNameStemForInstances (in category 'dropping/grabbing') -----
+ defaultNameStemForInstances
+ 	"Answer the default name on which to base names."
+ 
+ 	^ 'event timeline' translatedNoop!

Item was added:
+ ----- Method: EventTimeline>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
+ wantsDroppedMorph: aMorph event: evt
+ 	"Return true if the receiver wishes to accept the given morph, which is being dropped by a hand in response to the given event. Note that for a successful drop operation both parties need to agree. The symmetric check is done automatically via aMorph wantsToBeDroppedInto: self."
+ 
+ 	^ aMorph suitableForDroppingIntoEventRoll!

Item was added:
+ Object subclass: #ExtendedClipboardInterface
+ 	instanceVariableNames: 'clipboard'
+ 	classVariableNames: 'Current WinClipboardTypes'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Clipboard-Extended'!
+ ExtendedClipboardInterface class
+ 	instanceVariableNames: 'mimeTypeMap clipboardFormatMap'!
+ ExtendedClipboardInterface class
+ 	instanceVariableNames: 'mimeTypeMap clipboardFormatMap'!

Item was added:
+ ----- Method: ExtendedClipboardInterface class>>clipboardFormatMap (in category 'private') -----
+ clipboardFormatMap
+ 	^clipboardFormatMap!

Item was added:
+ ----- Method: ExtendedClipboardInterface class>>current (in category 'accessing') -----
+ current
+ 	| platform |
+ 	Current
+ 		ifNil: [Current := (Smalltalk includesKey: #CPlatform)
+ 						ifTrue: [(Smalltalk at: #CPlatform) current extendedClipboardInterfaceClass new]
+ 						ifFalse: ["workaround"
+ 							platform := SmalltalkImage current platformName.
+ 							platform = 'unix'
+ 								ifTrue: [ExtendedClipboardUnixInterface new]
+ 								ifFalse: [platform = 'Win32'
+ 										ifTrue: [ExtendedClipboardWinInterface new]
+ 										ifFalse: [ExtendedClipboardMacInterface new]]]].
+ 	^ Current!

Item was added:
+ ----- Method: ExtendedClipboardInterface class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"ExtendedClipboardInterface initialize"
+ 	Current := nil.
+ 	Smalltalk
+ 		addToStartUpList: self;
+ 		addToShutDownList: self.!

Item was added:
+ ----- Method: ExtendedClipboardInterface class>>mimeTypeMap (in category 'private') -----
+ mimeTypeMap
+ 	^mimeTypeMap!

Item was added:
+ ----- Method: ExtendedClipboardInterface class>>shutDown: (in category 'system startup') -----
+ shutDown: quitting
+ !

Item was added:
+ ----- Method: ExtendedClipboardInterface class>>startUp: (in category 'system startup') -----
+ startUp: resuming
+ 	"The image is either being newly started (resuming is true), or it's just been snapshotted"
+ 
+ 	Current := nil.
+ 	self current.!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>addClipboardData:dataFormat: (in category 'general-api-add') -----
+ addClipboardData: data dataFormat: aFormat
+ 	clipboard = 0 ifTrue: 
+ 		[Clipboard clipboardText: data asString.	
+ 		^self].
+ 	self primAddClipboardData: clipboard data: data dataFormat: aFormat.!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>addClipboardDataConvertFormToJPEG: (in category 'general-api-add') -----
+ addClipboardDataConvertFormToJPEG: aForm
+ 	
+ 	self useImageReadWriter: JPEGReadWriter2 
+ 		onForm: aForm 
+ 		addClipboardMethod: [:b | self addJPEGClipboardData: b].
+ !

Item was added:
+ ----- Method: ExtendedClipboardInterface>>addClipboardDataConvertFormToPNG: (in category 'general-api-add') -----
+ addClipboardDataConvertFormToPNG: aForm
+ 	
+ 	self useImageReadWriter: PNGReadWriter 
+ 		onForm: aForm 
+ 		addClipboardMethod: [:b | self addPNGClipboardData: b].
+ !

Item was added:
+ ----- Method: ExtendedClipboardInterface>>addClipboardDataResolveCorrectType: (in category 'general-api-add') -----
+ addClipboardDataResolveCorrectType: data
+ 	^data class addClipboardDataResolveCorrectType: data!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>addJPEGClipboardData: (in category 'general-api-add') -----
+ addJPEGClipboardData: data
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>addPNGClipboardData: (in category 'general-api-add') -----
+ addPNGClipboardData: data
+ 	"I'm not sure the proper way of default behavior, though, now I made it blank to avoid a temporary error. -- 6/28/2007 tak"
+ 	"Do nothing"!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>addRTFClipboardData: (in category 'general-api-add') -----
+ addRTFClipboardData: data
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>addStringClipboardData: (in category 'general-api-add') -----
+ addStringClipboardData: data
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>addTextClipboardData: (in category 'general-api-add') -----
+ addTextClipboardData: data
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>addWideStringClipboardData: (in category 'general-api-add') -----
+ addWideStringClipboardData: data
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>cleanupToCopyMorphic (in category 'general-api-add') -----
+ cleanupToCopyMorphic
+ 	"For some very complicated issue, this method is called when you copy a morph.
+ 	The morph is stored into PasteBuffer class variable. So text clipboard should not be
+ 	referenced. That's why this is needed. I'll re-implement it more straightforward way."
+ 	Clipboard clipboardText: ''.
+ !

Item was added:
+ ----- Method: ExtendedClipboardInterface>>clearClipboard (in category 'general-api-utility') -----
+ clearClipboard
+ 	clipboard = 0 ifTrue: [^self].
+ 	^ self primClearClipboard: clipboard.!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>clipboardMimeTypeExists: (in category 'testing') -----
+ clipboardMimeTypeExists: mimeType
+ 	| availableFormats |
+ 	availableFormats := self readAvailableFormats.
+ 	^availableFormats includes: mimeType!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>createClipboard (in category 'general-api-utility') -----
+ createClipboard
+ 	clipboard = 0 ifTrue: [^self].
+ 	^ self primCreateClipboard.!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>getClipboardFormat: (in category 'general-api-utility') -----
+ getClipboardFormat: formatNumber
+ 	clipboard = 0 ifTrue: [^nil].
+ 	^ self primGetClipboardFormat: clipboard formatNumber: formatNumber.!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>initialize (in category 'initialize-release') -----
+ initialize
+ 	clipboard := [self createClipboard] on: Error do: [:ex | clipboard := 0]!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>primAddClipboardData:data:dataFormat: (in category 'system primitives') -----
+ primAddClipboardData: clipboard data: data dataFormat: aFormat
+ 
+ 	<primitive:'ioAddClipboardData' module: 'ClipboardExtendedPlugin'>
+ 	^ self primitiveFailed.!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>primClearClipboard: (in category 'system primitives') -----
+ primClearClipboard: clipboard
+ 
+ 	<primitive:'ioClearClipboard' module: 'ClipboardExtendedPlugin'>
+ 	^ self primitiveFailed.
+ !

Item was added:
+ ----- Method: ExtendedClipboardInterface>>primCreateClipboard (in category 'system primitives') -----
+ primCreateClipboard
+ 	<primitive:'ioCreateClipboard' module: 'ClipboardExtendedPlugin'>
+ 	^ self primitiveFailed.
+ !

Item was added:
+ ----- Method: ExtendedClipboardInterface>>primGetClipboardFormat:formatNumber: (in category 'system primitives') -----
+ primGetClipboardFormat: clipboard formatNumber: formatNumber
+ 
+ 	<primitive:'ioGetClipboardFormat' module: 'ClipboardExtendedPlugin'>
+ 	^ self primitiveFailed.
+ !

Item was added:
+ ----- Method: ExtendedClipboardInterface>>primReadClipboardData:format: (in category 'system primitives') -----
+ primReadClipboardData: clipboard format: format
+ 
+ 	<primitive:'ioReadClipboardData' module: 'ClipboardExtendedPlugin'>.
+ 	^ self primitiveFailed.
+ !

Item was added:
+ ----- Method: ExtendedClipboardInterface>>readBMPClipboardData (in category 'general-api-read') -----
+ readBMPClipboardData
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>readByteStringClipboardData (in category 'general-api-read') -----
+ readByteStringClipboardData
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>readClipboardData: (in category 'general-api-read') -----
+ readClipboardData: format
+ 	^clipboard = 0 ifFalse: 
+ 		[self primReadClipboardData: clipboard format: format].!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>readFormClipboardData (in category 'general-api-read') -----
+ readFormClipboardData
+ 	^ nil!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>readJPEGClipboardData (in category 'general-api-read') -----
+ readJPEGClipboardData
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>readPNGClipboardData (in category 'general-api-read') -----
+ readPNGClipboardData
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>readRTFClipboardData (in category 'general-api-read') -----
+ readRTFClipboardData
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>readStringClipboardData (in category 'general-api-read') -----
+ readStringClipboardData
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>readTIFFClipboardData (in category 'general-api-read') -----
+ readTIFFClipboardData
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>readTextClipboardData (in category 'general-api-read') -----
+ readTextClipboardData
+ 	^ nil!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>readWideStringClipboardData (in category 'general-api-read') -----
+ readWideStringClipboardData
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>setTextString: (in category 'general-api-utility') -----
+ setTextString: aString
+ 	CClipboard clipboardText: aString!

Item was added:
+ ----- Method: ExtendedClipboardInterface>>useImageReadWriter:onForm:addClipboardMethod: (in category 'general-api-add') -----
+ useImageReadWriter: aImageReadWriterClass onForm: aForm addClipboardMethod: aAddClipBoardBlock
+ 	| estimate buffer stream pngConverter |
+ 	(aForm isKindOf: Form) ifTrue: 
+ 		[estimate _ (aForm extent x)*(aForm extent y).
+ 		estimate _ 1024 max: (estimate * 4 * 3 // 4).
+ 		buffer _ ByteArray new: estimate.
+ 		stream _ (RWBinaryOrTextStream on: buffer) binary .
+ 		pngConverter _ aImageReadWriterClass on: stream.
+ 		pngConverter nextPutImage: aForm.
+ 		pngConverter close.	
+ 		aAddClipBoardBlock value: stream contents].
+ 		
+ !

Item was added:
+ ExtendedClipboardInterface subclass: #ExtendedClipboardMacInterface
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Clipboard-Extended'!

Item was added:
+ ----- Method: ExtendedClipboardMacInterface class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"ExtendedClipboardMacInterface initialize"
+  
+ 	self
+ 		initializeClipboardFormatMap; 
+ 		initializeMimeTypeMap!

Item was added:
+ ----- Method: ExtendedClipboardMacInterface class>>initializeClipboardFormatMap (in category 'class initialization') -----
+ initializeClipboardFormatMap
+ 	"ExtendedClipboardMacInterface initializeClipboardFormatMap"
+ 
+ 	clipboardFormatMap := Dictionary new.
+ 	clipboardFormatMap
+ 		at: 'public.rtf' put: 'text/rtf' asMIMEType; 
+ 		at: 'com.apple.traditional-mac-plain-text' put: 'text/plain' asMIMEType;
+ 		at: 'public.png' put: 'image/png' asMIMEType;
+ 		at: 'public.jpeg' put: 'image/jpeg' asMIMEType; 
+ 		at: 'public.tiff' put: 'image/tiff' asMIMEType; 
+ 		at: 'public.utf16-plain-text' put: 'text/unicode' asMIMEType;
+ 		at: 'public.utf8-plain-text' put: 'text/utf8-unicode' asMIMEType;
+ 		yourself
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface class>>initializeMimeTypeMap (in category 'class initialization') -----
+ initializeMimeTypeMap
+ 	"ExtendedClipboardWinInterface initializeMimeTypeMap"
+ 
+ 	mimeTypeMap := Dictionary new.
+ 	mimeTypeMap
+ 		at: 'text/rtf' asMIMEType put: 'public.rtf'; 
+ 		at: 'text/*' asMIMEType put: 'com.apple.traditional-mac-plain-text';
+ 		at: 'image/jpeg' asMIMEType put: 'public.jpeg';
+ 		at: 'image/png' asMIMEType put: 'public.png';
+ 		at: 'text/unicode' asMIMEType put: 'public.utf8-plain-text';
+ 		yourself
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>addJPEGClipboardData: (in category 'general-api-add') -----
+ addJPEGClipboardData: data
+ 	self clearClipboard.
+ 	self addClipboardData: data dataFormat: 'public.jpeg'
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>addPNGClipboardData: (in category 'general-api-add') -----
+ addPNGClipboardData: data
+ 	self clearClipboard.
+ 	self addClipboardData: data dataFormat: 'public.png'
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>addRTFClipboardData: (in category 'general-api-add') -----
+ addRTFClipboardData: data
+ 	self clearClipboard.
+ 	self addClipboardData: data dataFormat: 'public.rtf'
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>addStringClipboardData: (in category 'general-api-add') -----
+ addStringClipboardData: data
+ 	self clearClipboard.
+ 	self addClipboardData: data dataFormat: 'public.text'
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>addTextClipboardData: (in category 'general-api-add') -----
+ addTextClipboardData: data
+ 	| buffer stream |
+ 	self clearClipboard.
+ 	self addClipboardData: data asString dataFormat: 'public.text'.
+ 	self halt.
+ 	buffer _ ByteArray new: 2048.
+ 	stream _ (RWBinaryOrTextStream on: buffer) binary .
+ 	data serializeOn:  stream.
+ 	self addClipboardData: (buffer copyFrom: 1 to: stream size) dataFormat: 'org.squeak.text'.
+  
+ 
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>addUF8StringClipboardData: (in category 'general-api-add') -----
+ addUF8StringClipboardData: aString
+ 	| ba  |
+ 
+ 	self clearClipboard.
+ 	ba := aString convertToWithConverter: (UTF8TextConverter new).
+ 	self addClipboardData: ba dataFormat: 'public.utf8-plain-text'
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>addWideStringClipboardData: (in category 'general-api-add') -----
+ addWideStringClipboardData: aString
+ 	| ba  |
+ 
+ 	self clearClipboard.
+ 	ba := aString convertToWithConverter: (UTF16TextConverter new useByteOrderMark: true).
+ 	self addClipboardData: ba dataFormat: 'public.utf16-plain-text'
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>readAvailableFormats (in category 'general-api-read') -----
+ readAvailableFormats
+ 	| currentFormat availableFormats mimeType formatData |
+ 	availableFormats := OrderedCollection new: 10.
+ 	currentFormat := 1.
+ 	[formatData := self getClipboardFormat: currentFormat.
+ 	formatData notNil]
+ 		whileTrue: [
+ 			mimeType := self class clipboardFormatMap at: formatData asString ifAbsent: [nil].
+ 			mimeType ifNotNil: [
+ 				availableFormats add: mimeType].
+ 		currentFormat := currentFormat +1].
+ 	^availableFormats!

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>readByteStringClipboardData (in category 'general-api-read') -----
+ readByteStringClipboardData
+ 	^(self readClipboardData: 'com.apple.traditional-mac-plain-text')
+ 		ifNotNilDo: [: bytes | bytes asString macToSqueak]
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>readFormClipboardData (in category 'general-api-read') -----
+ readFormClipboardData
+ 	| bytes formats |
+ 	formats := self readAvailableFormats.
+ 	(formats includes: 'image/png' asMIMEType)
+ 		ifTrue: [bytes := self readPNGClipboardData.
+ 			^ (PNGReadWriter on: bytes readStream) nextImage].
+ 	(formats includes: 'image/jpeg' asMIMEType)
+ 		ifTrue: [bytes := self readJPEGClipboardData.
+ 			^ (JPEGReadWriter2 on: bytes readStream) nextImage].
+ 	^ nil!

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>readJPEGClipboardData (in category 'general-api-read') -----
+ readJPEGClipboardData
+ 	| bytes |
+ 	bytes := self readClipboardData: 'public.jpeg'.
+ 	^bytes
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>readPNGClipboardData (in category 'general-api-read') -----
+ readPNGClipboardData
+ 	| bytes |
+ 	bytes := self readClipboardData: 'public.png'.
+ 	^bytes
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>readRTFClipboardData (in category 'general-api-read') -----
+ readRTFClipboardData
+ 	| bytes |
+ 	bytes := self readClipboardData: 'public.rtf'.
+ 	^bytes ifNil: [bytes] ifNotNil: [bytes asString]
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>readStringClipboardData (in category 'general-api-read') -----
+ readStringClipboardData
+ 	| string |
+ 	string := self readUTF8StringClipboardData.
+ 	string ifNil: [string := self readWideStringClipboardData].
+ 	string ifNil: [string := self readByteStringClipboardData].
+ 	^string
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>readTIFFClipboardData (in category 'general-api-read') -----
+ readTIFFClipboardData
+ 	| bytes |
+ 	bytes := self readClipboardData: 'public.tiff'.
+ 	^bytes
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>readTextClipboardData (in category 'general-api-read') -----
+ readTextClipboardData
+ 	^self readStringClipboardData
+ 		ifNotNilDo: [:string | (string replaceAll: Character lf with: Character cr) asText]
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>readUTF8StringClipboardData (in category 'general-api-read') -----
+ readUTF8StringClipboardData
+ 	^(self readClipboardData: 'public.utf8-plain-text')
+ 		ifNotNilDo: [:bytes |
+ 			[bytes asString utf8ToSqueak] ifError: [bytes asString] ]
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>readWideStringClipboardData (in category 'general-api-read') -----
+ readWideStringClipboardData
+ 	| bytes |
+ 	"utf16 plain text has no bom"
+ 
+ 	bytes := self readClipboardData: 'public.utf16-plain-text'.
+ 	^bytes ifNil: [bytes] ifNotNil: 
+ 		[bytes asString convertFromWithConverter: (UTF16TextConverter new useLittleEndian: (SmalltalkImage current endianness = #little)
+ )]
+ !

Item was added:
+ ----- Method: ExtendedClipboardMacInterface>>setTextString: (in category 'general-api-utility') -----
+ setTextString: aString
+ 	super setTextString: aString.
+ 	aString isWideString
+ 		ifTrue: [self addUF8StringClipboardData: aString].
+ 	MacServicesInterface current setTextString: aString!

Item was added:
+ ExtendedClipboardInterface subclass: #ExtendedClipboardUnixInterface
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Clipboard-Extended'!

Item was added:
+ ----- Method: ExtendedClipboardUnixInterface>>addPNGClipboardData: (in category 'general-api-add') -----
+ addPNGClipboardData: data
+ 	self clearClipboard.
+ 	self addClipboardData: data dataFormat: 'image/png'
+ !

Item was added:
+ ----- Method: ExtendedClipboardUnixInterface>>cleanupToCopyMorphic (in category 'general-api-add') -----
+ cleanupToCopyMorphic
+ 	Clipboard default delete.
+ !

Item was added:
+ ----- Method: ExtendedClipboardUnixInterface>>readAvailableFormats (in category 'general-api-read') -----
+ readAvailableFormats
+ 	| currentFormat availableFormats mimeType formatData |
+ 	availableFormats := OrderedCollection new: 10.
+ 	currentFormat := 1.
+ 	[formatData := self getClipboardFormat: currentFormat.
+ 	formatData notNil]
+ 		whileTrue: [
+ 			"mimeType := self class clipboardFormatMap at: formatData asString ifAbsent: [nil]".
+ 			mimeType := formatData.
+ 			mimeType ifNotNil: [
+ 				availableFormats add: mimeType].
+ 		currentFormat := currentFormat +1].
+ 	^availableFormats!

Item was added:
+ ----- Method: ExtendedClipboardUnixInterface>>readFormClipboardData (in category 'general-api-read') -----
+ readFormClipboardData
+ 	| bytes formats |
+ 	formats := self readAvailableFormats.
+ 	(formats includes: 'image/png')
+ 		ifTrue: [bytes := self readClipboardData: 'image/png'.
+ 			^ (PNGReadWriter on: bytes readStream) nextImage].
+ 	(formats includes: 'image/bmp')
+ 		ifTrue: [bytes := self readClipboardData: 'image/bmp'.
+ 			^ (BMPReadWriter on: bytes readStream) nextImage].
+ 	^ nil!

Item was added:
+ ----- Method: ExtendedClipboardUnixInterface>>readHTMLClipboardData (in category 'general-api-read') -----
+ readHTMLClipboardData
+ 	| bytes source |
+ 	"Answer a HTMLDocument object"
+ 	bytes := self readClipboardData: 'text/html'.
+ 	(bytes beginsWith: '<!!DOCTYPE' asByteArray)
+ 		ifTrue: ["BAD HACK for Abiword"
+ 			source := bytes asString convertFromWithConverter: UTF8TextConverter new]
+ 		ifFalse: ["BAD HACK for mozilla"
+ 			source := bytes asString
+ 						convertFromWithConverter: (UTF16TextConverter new useLittleEndian: SmalltalkImage current isLittleEndian)].
+ 	^ HtmlParser parse: source readStream!

Item was added:
+ ----- Method: ExtendedClipboardUnixInterface>>readStringClipboardData (in category 'general-api-read') -----
+ readStringClipboardData
+ 	^self readWideStringClipboardData!

Item was added:
+ ----- Method: ExtendedClipboardUnixInterface>>readTextClipboardData (in category 'general-api-read') -----
+ readTextClipboardData
+ 	| formats |
+ 	formats := self readAvailableFormats.
+ 	(formats includes: 'text/html')
+ 		ifTrue: [^ self readHTMLClipboardData formattedText].
+ 	(formats includes: 'UTF8_STRING')
+ 		ifTrue: [^self readWideStringClipboardData asText].
+ 	(formats includes: 'STRING')
+ 		ifTrue: ["handled by old clipboard code, fall through"].
+ 	^ nil!

Item was added:
+ ----- Method: ExtendedClipboardUnixInterface>>readWideStringClipboardData (in category 'general-api-read') -----
+ readWideStringClipboardData
+ 	^(self readClipboardData: 'UTF8_STRING') asString utf8ToSqueak!

Item was added:
+ ExtendedClipboardInterface subclass: #ExtendedClipboardWinInterface
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Clipboard-Extended'!

Item was added:
+ ----- Method: ExtendedClipboardWinInterface class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"ExtendedClipboardWinInterface initialize"
+ 
+ 	self
+ 		initializeClipboardFormatMap;
+ 		initializeMimeTypeMap!

Item was added:
+ ----- Method: ExtendedClipboardWinInterface class>>initializeClipboardFormatMap (in category 'class initialization') -----
+ initializeClipboardFormatMap
+ 	"ExtendedClipboardWinInterface initializeClipboardFormatMap"
+ 
+ 	clipboardFormatMap := Dictionary new.
+ 	"at: 6 put: 'image/tiff' asMIMEType; CF_TIFF"
+ 
+ 	clipboardFormatMap
+ 		at: 49510 put: 'text/rtf' asMIMEType; 
+ 		at: 1 put: 'text/plain' asMIMEType; "CF_TEXT"
+ 		at: 2 put: 'image/bmp' asMIMEType; "CF_BITMAP"
+ 		at: 12 put: 'audio/wave'; "CF_WAVE"
+ 		at: 13 put: 'text/unicode' asMIMEType; "CF_UNICODETEXT"
+ 		at: 16 put: 'CF_LOCALE'; "CF_LOCALE"
+ 		yourself.
+ 
+ 
+ !

Item was added:
+ ----- Method: ExtendedClipboardWinInterface class>>initializeMimeTypeMap (in category 'class initialization') -----
+ initializeMimeTypeMap
+ 	"ExtendedClipboardWinInterface initializeMimeTypeMap"
+ 
+ 	mimeTypeMap := Dictionary new.
+ 	mimeTypeMap
+ 		at: 'text/rtf' asMIMEType put: 49510; 
+ 		at: 'text/plain' asMIMEType put: 1; "CF_TEXT"
+ 		at: 'image/*' asMIMEType put: 2; "CF_BITMAP"
+ 		at: 'metafile' put: 3; "CF_METAFILEPICT"
+ 		at: 'CF_SYLK' put: 4; "CF_SYLK"
+ 		at: 'CF_DIF' put: 5; "CF_DIF"
+ 		at: 'image/tiff' asMIMEType put: 6; "CF_TIFF"
+ 		at: 'oemtext' put: 7; "CF_OEMTEXT"
+ 		at: 'CF_DIB' put: 8; "CF_DIB"
+ 		at: 'CF_PALETTE' put: 9; "CF_PALETTE"
+ 		at: 'CF_PENDATA' put: 10; "CF_PENDATA"
+ 		at: 'CF_RIFF' put: 11; "CF_RIFF"
+ 		at: 'wave' put: 12; "CF_WAVE"
+ 		at: 'text/unicode' asMIMEType put: 13; "CF_UNICODETEXT"
+ 		at: 'CF_ENHMETAFILE' put: 14; "CF_ENHMETAFILE"
+ 		at: 'CF_HDROP' put: 15; "CF_HDROP"
+ 		at: 'CF_LOCALE' put: 16; "CF_LOCALE"
+ 		at: 'CF_DIBV5' put: 17; "CF_DIBV5"
+ 		yourself
+ !

Item was added:
+ ----- Method: ExtendedClipboardWinInterface>>readAvailableFormats (in category 'general-api-read') -----
+ readAvailableFormats
+ 	| currentFormat availableFormats mimeType |
+ 	availableFormats := OrderedCollection new: 10.
+ 	currentFormat := 0.
+ 	self openClipboard.
+ 	[currentFormat := self format: currentFormat.
+ 	currentFormat ~= 0]
+ 		whileTrue: [
+ 			mimeType := self class clipboardFormatMap at: currentFormat ifAbsent: [nil].
+ 			mimeType ifNotNil: [
+ 				availableFormats add: mimeType]].
+ 	self closeClipboard.
+ 	^availableFormats!

Item was added:
+ ----- Method: ExtendedClipboardWinInterface>>readBMPClipboardData (in category 'general-api-read') -----
+ readBMPClipboardData
+ 	| string |
+ 	self openClipboard.
+ 	[string := (self getClipboardData: (self class mimeTypeMap at: 'image/*' asMIMEType)) fromCString]
+ 		ensure: [self closeClipboard].
+ 	^string!

Item was added:
+ ----- Method: ExtendedClipboardWinInterface>>readFormClipboardData (in category 'general-api-read') -----
+ readFormClipboardData
+ 	| bytes formats |
+ 	formats := self readAvailableFormats.
+ 	(formats includes: 'image/bmp' asMIMEType)
+ 		ifTrue: [bytes := self readBMPClipboardData.
+ 			^ (BMPReadWriter on: bytes readStream) nextImage].
+ 	^ nil!

Item was added:
+ ----- Method: ExtendedClipboardWinInterface>>readRTFClipboardData (in category 'general-api-read') -----
+ readRTFClipboardData
+ 	| string |
+ 	self openClipboard.
+ 	[string := (self getClipboardData: (self class mimeTypeMap at: 'text/rtf' asMIMEType)) fromCString]
+ 		ensure: [self closeClipboard].
+ 	^string!

Item was added:
+ ----- Method: ExtendedClipboardWinInterface>>readStringClipboardData (in category 'general-api-read') -----
+ readStringClipboardData
+ 	| string |
+ 	self openClipboard.
+ 	[string := (self getClipboardData: (self class mimeTypeMap at: 'text/plain' asMIMEType)) fromCString]
+ 		ensure: [self closeClipboard].
+ 	^string!

Item was added:
+ ----- Method: ExtendedClipboardWinInterface>>readTIFFClipboardData (in category 'general-api-read') -----
+ readTIFFClipboardData
+ 	| string |
+ 	self openClipboard.
+ 	[string := (self getClipboardData: (self class mimeTypeMap at: 'image/tiff' asMIMEType)) fromCString]
+ 		ensure: [self closeClipboard].
+ 	^string!

Item was added:
+ ----- Method: ExtendedClipboardWinInterface>>readWideStringClipboardData (in category 'general-api-read') -----
+ readWideStringClipboardData
+ 	| string |
+ 	self openClipboard.
+ 	[string := (self getClipboardData: (self class mimeTypeMap at: 'text/unicode' asMIMEType)) fromUTF16String]
+ 		ensure: [self closeClipboard].
+ 	^string!

Item was added:
+ ----- Method: ExternalDropHandler class>>defaultMidiHandler (in category '*Etoys-Squeakland-private') -----
+ defaultMidiHandler
+ 	^ ExternalDropHandler
+ 		type: 'audio/midi'
+ 		extension: 'mid'
+ 		action: [:stream | ScorePlayerMorph playMidiStream: stream]!

Item was added:
+ ----- Method: ExternalDropHandler class>>defaultMorphHandler (in category '*Etoys-Squeakland-private') -----
+ defaultMorphHandler
+ 	^ ExternalDropHandler
+ 		type: nil
+ 		extension: 'morph'
+ 		action: [:stream | (Morph fromStreamedRepresentation: stream contents) openInWorld]!

Item was added:
+ ----- Method: ExternalDropHandler>>action (in category '*Etoys-Squeakland-accessing') -----
+ action
+ 	"Answer the value of my action."
+ 
+ 	^ action!

Item was added:
+ Form subclass: #ExternalForm
+ 	instanceVariableNames: 'display argbMap'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Graphics-External'!
+ 
+ !ExternalForm commentStamp: '<historical>' prior: 0!
+ An ExternalForm is just like any other form. It's only difference is that it is allocated on a specific display and can be used for accelerated blts on the particular display.
+ 
+ Upon shutdown of the system ExternalForms will be deallocated from the display and be kept in their internalized form.!

Item was added:
+ ----- Method: ExternalForm>>colormapFromARGB (in category 'accessing') -----
+ colormapFromARGB
+ 	"Return a ColorMap mapping from canonical ARGB pixel values into the receiver"
+ 	^argbMap ifNil:[argbMap _ ColorMap mappingFromARGB: self rgbaBitMasks].!

Item was added:
+ ----- Method: ExternalForm>>colormapFromARGB: (in category 'accessing') -----
+ colormapFromARGB: aMap
+ 	"Set the ColorMap mapping from canonical ARGB pixel values into the receiver"
+ 	argbMap _ aMap!

Item was added:
+ ----- Method: ExternalForm>>destroy (in category 'initialize-release') -----
+ destroy
+ 	"Destroy the receiver"
+ 	display ifNotNil:[display destroyForm: self]!

Item was added:
+ ----- Method: ExternalForm>>displayScreen (in category 'accessing') -----
+ displayScreen
+ 	"Return the display screen the receiver is allocated on."
+ 	^display!

Item was added:
+ ----- Method: ExternalForm>>getExternalHandle (in category 'private') -----
+ getExternalHandle
+ 	"Private. Return the virtual handle used to represent the receiver"
+ 	^bits!

Item was added:
+ ----- Method: ExternalForm>>hasNonStandardPalette (in category 'testing') -----
+ hasNonStandardPalette
+ 	"Quite possible."
+ 	^display notNil or:[argbMap notNil]!

Item was added:
+ ----- Method: ExternalForm>>isExternalForm (in category 'testing') -----
+ isExternalForm
+ 	"I am an external form but only as long as I'm allocated on a display"
+ 	^display notNil!

Item was added:
+ ----- Method: ExternalForm>>rgbaBitMasks (in category 'accessing') -----
+ rgbaBitMasks
+ 	"Return the masks for specifying the R,G,B, and A components in the receiver"
+ 	display 
+ 		ifNil:[^super rgbaBitMasks]
+ 		ifNotNil:[^display rgbaBitMasksOfForm: self]!

Item was added:
+ ----- Method: ExternalForm>>setExternalHandle:on: (in category 'private') -----
+ setExternalHandle: aHandle on: aDisplay
+ 	"Initialize the receiver from the given external handle"
+ 	display _ aDisplay.
+ 	bits _ aHandle.!

Item was added:
+ ----- Method: ExternalForm>>shutDown (in category 'initialize-release') -----
+ shutDown
+ 	"System is going down. Internalize my bits and be finished."
+ 	| copy |
+ 	copy _ Form extent: self extent depth: self depth.
+ 	self displayOn: copy.
+ 	copy hibernate. "compact bits of copy"
+ 	self destroy. "Release my external handle"
+ 	bits _ copy bits. "Now compressed"
+ 	display _ nil. "No longer allocated"
+ 	argbMap _ nil. "No longer external"!

Item was added:
+ WeakKeyDictionary subclass: #ExternalFormRegistry
+ 	instanceVariableNames: 'lockFlag'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Graphics-External'!
+ 
+ !ExternalFormRegistry commentStamp: '<historical>' prior: 0!
+ The ExternalFormRegistry needs to be synchronized with rendering to prevent forms from being destroyed during rendering. Only at certain points (that is after a rendering cycle is completed) the texture registry may be cleaned up.!

Item was added:
+ ----- Method: ExternalFormRegistry>>finalizeValues (in category 'finalization') -----
+ finalizeValues
+ 	"This message is sent when an element has gone away."
+ 	lockFlag == true ifTrue:[^self].
+ 	self forceFinalization.!

Item was added:
+ ----- Method: ExternalFormRegistry>>forceFinalization (in category 'finalization') -----
+ forceFinalization
+ 	self associationsDo:[:assoc|
+ 		assoc key isNil ifTrue:[assoc value destroy].
+ 	].
+ 	super finalizeValues.!

Item was added:
+ ----- Method: ExternalFormRegistry>>lock (in category 'accessing') -----
+ lock
+ 	lockFlag _ true!

Item was added:
+ ----- Method: ExternalFormRegistry>>unlock (in category 'accessing') -----
+ unlock
+ 	lockFlag _ false.!

Item was added:
+ DisplayScreen subclass: #ExternalScreen
+ 	instanceVariableNames: 'argbMap allocatedForms'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Graphics-External'!
+ 
+ !ExternalScreen commentStamp: '<historical>' prior: 0!
+ I represent a DisplayScreen that is not part of the Squeak universe. Subclasses must implement the appropriate primitives for creating, destroying and allocating the appropriate external objects.
+ 
+ Note: It is assumed that all external display surfaces are accessible by FXBlt, meaning that any support code must register the surfaces with the surface plugin. This requires that the support code will have a way of accessing the bits of the surface. Although this can be terribly expensive (such as on X where a roundtrip to the server might be required or for an OpenGL display where glReadPixels usually is slow as hell) the appropriate methods should be implemented. This allows for a gradual transition to less expensive model (such as implementing an X11Canvas supporting the drawing primitives of X) and is therefore the preferred solution.
+ 
+ In the eventual case that it's known that BitBlt/FXBlt will *never* be used in conjunction with a particular drawing surface, the support code should return a handle that is a) not a SmallInteger (these are used by the surface plugin) and b) not of the 'bitsSize' of a Form. One possible representation for such a handle would be a ByteArray of a non-integral word size (e.g., a ByteArray of size 5,6, or 7). In this case, all attempts to use FXBlt with the drawing surface will simply fail.
+ !

Item was added:
+ ----- Method: ExternalScreen>>allocateForm: (in category 'form support') -----
+ allocateForm: extentPoint
+ 	"Allocate a new form which is similar to the receiver and can be used for accelerated blts"
+ 	| formHandle displayForm |
+ 	formHandle _ self primAllocateForm: self depth width: extentPoint x height: extentPoint y.
+ 	formHandle = nil ifTrue:[^super allocateForm: extentPoint].
+ 	displayForm _ (ExternalForm extent: extentPoint depth: self depth bits: nil) 
+ 		setExternalHandle: formHandle on: self.
+ 	allocatedForms at: displayForm put: displayForm executor.
+ 	^displayForm!

Item was added:
+ ----- Method: ExternalScreen>>colormapFromARGB (in category 'accessing') -----
+ colormapFromARGB
+ 	"Return a ColorMap mapping from canonical ARGB pixel values into the receiver"
+ 	^argbMap ifNil:[argbMap _ ColorMap mappingFromARGB: self rgbaBitMasks].!

Item was added:
+ ----- Method: ExternalScreen>>copyBits:from:at:clippingBox:rule:fillColor:map: (in category 'blitting support') -----
+ copyBits: sourceRect from: sourceForm at: destOrigin clippingBox: clipRect rule: rule fillColor: hf map: map
+ 	"Attempt to accelerate blts to the receiver"
+ 	| r |
+ 	((self isBltAccelerated: rule for: sourceForm) and:[map == nil and:[hf == nil]]) ifTrue:[
+ 		"Try an accelerated blt"
+ 		r _ (destOrigin extent: sourceRect extent) intersect: (clipRect intersect: clippingBox).
+ 		r area <= 0 ifTrue:[^self].
+ 		(self primBltFast: bits from: sourceForm getExternalHandle
+ 			at: r origin from: sourceRect origin
+ 			extent: r extent) ifNotNil:[^self].
+ 	].
+ 	^super copyBits: sourceRect from: sourceForm at: destOrigin clippingBox: clipRect rule: rule fillColor: hf map: map!

Item was added:
+ ----- Method: ExternalScreen>>destroy (in category 'initialize-release') -----
+ destroy
+ 	"Destroy the receiver"
+ 	allocatedForms ifNotNil:[
+ 		allocatedForms lock. "Make sure we don't get interrupted"
+ 		allocatedForms forceFinalization. "Clean up all lost references"
+ 		allocatedForms keys do:[:stillValid| stillValid shutDown].
+ 		"All remaining references are simply destroyed"
+ 		allocatedForms associationsDo:[:assoc| assoc key: nil].
+ 		allocatedForms forceFinalization. "destroy all others"
+ 		allocatedForms _ nil.
+ 	].
+ 	bits ifNotNil:[self primDestroyDisplaySurface: bits].
+ 	bits _ nil.!

Item was added:
+ ----- Method: ExternalScreen>>destroyForm: (in category 'form support') -----
+ destroyForm: anExternalForm
+ 	"Destroy the given external form"
+ 	self primDestroyForm: anExternalForm getExternalHandle.
+ 	anExternalForm setExternalHandle: nil on: nil.
+ 	allocatedForms removeKey: anExternalForm ifAbsent:[].!

Item was added:
+ ----- Method: ExternalScreen>>displayOn:at:clippingBox:rule:fillColor: (in category 'blitting support') -----
+ displayOn: destForm at: destOrigin clippingBox: clipRect rule: rule fillColor: hf
+ 	"Attempt to accelerate blts to aDisplayMedium"
+ 	| sourceRect |
+ 	((self isBltAccelerated: rule for: destForm) and:[hf = nil]) ifTrue:[
+ 		"Try an accelerated blt"
+ 		sourceRect _ (clipRect translateBy: destOrigin negated) intersect: clippingBox.
+ 		(self primBltFast: bits to: destForm getExternalHandle
+ 			at: 0 at 0 from: sourceRect origin
+ 			extent: sourceRect extent) ifNotNil:[^self]].
+ 	destForm copyBits: self boundingBox
+ 		from: self
+ 		at: destOrigin + self offset
+ 		clippingBox: clipRect
+ 		rule: rule
+ 		fillColor: hf
+ 		map: (self colormapIfNeededFor: destForm).
+ !

Item was added:
+ ----- Method: ExternalScreen>>fill:rule:fillColor: (in category 'blitting support') -----
+ fill: aRectangle rule: anInteger fillColor: aColor 
+ 	"Replace a rectangular area of the receiver with the pattern described by aForm 
+ 	according to the rule anInteger."
+ 	| rect |
+ 	(self isFillAccelerated: anInteger for: aColor) ifTrue:[
+ 		rect _ aRectangle intersect: clippingBox.
+ 		(self primFill: bits
+ 			color: (self pixelWordFor: aColor)
+ 			x: rect left
+ 			y: rect top
+ 			w: rect width
+ 			h: rect height) ifNotNil:[^self]].
+ 	^super fill: aRectangle rule: anInteger fillColor: aColor!

Item was added:
+ ----- Method: ExternalScreen>>finish (in category 'initialize-release') -----
+ finish
+ 	"Flush the receiver"
+ 	self primFinish: bits.
+ 	"Now is the time to do some cleanup"
+ 	allocatedForms unlock.
+ 	allocatedForms finalizeValues.!

Item was added:
+ ----- Method: ExternalScreen>>flush (in category 'initialize-release') -----
+ flush
+ 	"Flush the receiver"
+ 	self primFlush: bits.!

Item was added:
+ ----- Method: ExternalScreen>>hasNonStandardPalette (in category 'testing') -----
+ hasNonStandardPalette
+ 	"Quite possible."
+ 	^true!

Item was added:
+ ----- Method: ExternalScreen>>isBltAccelerated:for: (in category 'blitting support') -----
+ isBltAccelerated: ruleInteger for: aForm
+ 	"Return true if the receiver can perform accelerated blt operations by itself.
+ 	It is assumed that blts of forms allocated on the receiverusing Form>>over 
+ 	may be accelerated.
+ 	Although some hardware may allow source-key blts (that is, Form>>paint or similar)
+ 	this is usually questionable and the additional effort for allocating and
+ 	maintaining the OS form doesn't quite seem worth the effort."
+ 	^aForm displayScreen == self and:[ruleInteger = Form over]!

Item was added:
+ ----- Method: ExternalScreen>>isExternalForm (in category 'testing') -----
+ isExternalForm
+ 	"Sorta. Kinda."
+ 	^true!

Item was added:
+ ----- Method: ExternalScreen>>isFillAccelerated:for: (in category 'blitting support') -----
+ isFillAccelerated: ruleInteger for: aColor
+ 	"Return true if the receiver can perform accelerated fill operations by itself.
+ 	It is assumed that the hardware can accelerate plain color fill operations."
+ 	^ruleInteger = Form over and:[aColor isColor]!

Item was added:
+ ----- Method: ExternalScreen>>primAllocateForm:width:height: (in category 'primitives-forms') -----
+ primAllocateForm: d width: w height: h
+ 	"Primitive. Allocate a form with the given parameters"
+ 	^nil!

Item was added:
+ ----- Method: ExternalScreen>>primBltFast:from:at:from:extent: (in category 'primitives-display') -----
+ primBltFast: displayHandle from: sourceHandle at: destOrigin from: sourceOrigin extent: extent
+ 	"Primitive. Perform a fast blt operation. Return the receiver if successful."
+ 	^nil!

Item was added:
+ ----- Method: ExternalScreen>>primBltFast:to:at:from:extent: (in category 'primitives-display') -----
+ primBltFast: displayHandle to: dstHandle at: destOrigin from: sourceOrigin extent: extent
+ 	"Primitive. Perform a fast blt operation. Return the receiver if successful."
+ 	^nil!

Item was added:
+ ----- Method: ExternalScreen>>primCreateDisplaySurface:width:height: (in category 'primitives-display') -----
+ primCreateDisplaySurface: d width: w height: h
+ 	"Primitive. Create a new external display surface. Return the handle used to identify the receiver. Fail if the surface cannot be created."
+ 	^nil!

Item was added:
+ ----- Method: ExternalScreen>>primDestroyDisplaySurface: (in category 'primitives-display') -----
+ primDestroyDisplaySurface: aHandle
+ 	"Primitive. Destroy the display surface associated with the given handle."
+ 	^nil!

Item was added:
+ ----- Method: ExternalScreen>>primDestroyForm: (in category 'primitives-forms') -----
+ primDestroyForm: aHandle
+ 	"Primitive. Destroy the form associated with the given handle."
+ 	^nil!

Item was added:
+ ----- Method: ExternalScreen>>primDisplay:colorMasksInto: (in category 'primitives-display') -----
+ primDisplay: aHandle colorMasksInto: anArray
+ 	"Primitive. Store the bit masks for each color into the given array."
+ 	^nil!

Item was added:
+ ----- Method: ExternalScreen>>primFill:color:x:y:w:h: (in category 'primitives-display') -----
+ primFill: handle color: pixelWord x: x y: y w: w h: h
+ 	"Primitive. Perform an accelerated fill operation on the receiver."
+ 	^nil!

Item was added:
+ ----- Method: ExternalScreen>>primFinish: (in category 'primitives-display') -----
+ primFinish: aHandle
+ 	"Primitive. Finish all rendering operations on the receiver.
+ 	Do not return before all rendering operations have taken effect."
+ 	^nil!

Item was added:
+ ----- Method: ExternalScreen>>primFlush: (in category 'primitives-display') -----
+ primFlush: aHandle
+ 	"Primitive. If any rendering operations are pending, force them to be executed.
+ 	Do not wait until they have taken effect."
+ 	^nil!

Item was added:
+ ----- Method: ExternalScreen>>primForm:colorMasksInto: (in category 'primitives-forms') -----
+ primForm: aHandle colorMasksInto: anArray
+ 	"Primitive. Store the bit masks for each color into the given array."
+ 	^nil!

Item was added:
+ ----- Method: ExternalScreen>>release (in category 'initialize-release') -----
+ release
+ 	"I am no longer Display. Release any resources if necessary"
+ 	self destroy!

Item was added:
+ ----- Method: ExternalScreen>>rgbaBitMasks (in category 'accessing') -----
+ rgbaBitMasks
+ 	"Return the masks for specifying the R,G,B, and A components in the receiver"
+ 	| rgbaBitMasks |
+ 	rgbaBitMasks _ Array new: 4.
+ 	self primDisplay: bits colorMasksInto: rgbaBitMasks.
+ 	^rgbaBitMasks!

Item was added:
+ ----- Method: ExternalScreen>>rgbaBitMasksOfForm: (in category 'form support') -----
+ rgbaBitMasksOfForm: anExternalForm
+ 	| rgbaBitMasks |
+ 	rgbaBitMasks _ Array new: 4.
+ 	self primForm: anExternalForm getExternalHandle colorMasksInto: rgbaBitMasks.
+ 	^rgbaBitMasks!

Item was added:
+ ----- Method: ExternalScreen>>setExtent:depth: (in category 'private') -----
+ setExtent: aPoint depth: bitsPerPixel
+ 	"Create a 3D accelerated display screen"
+ 	| screen |
+ 	(bits isInteger and:[depth == bitsPerPixel and: [aPoint = self extent and: 
+ 					[self supportsDisplayDepth: bitsPerPixel]]]) ifFalse: [
+ 		bits ifNotNil:[self primDestroyDisplaySurface: bits].
+ 		bits _ nil.  "Free up old bitmap in case space is low"
+ 		DisplayChangeSignature _ (DisplayChangeSignature ifNil: [0]) + 1.
+ 		(self supportsDisplayDepth: bitsPerPixel)
+ 			ifTrue:[depth _ bitsPerPixel]
+ 			ifFalse:["Search for a suitable depth"
+ 					depth _ self findAnyDisplayDepthIfNone:[nil]].
+ 		depth == nil ifFalse:[
+ 			bits _ self primCreateDisplaySurface: depth 
+ 					width: aPoint x height: aPoint y].
+ 		"Bail out if surface could not be created"
+ 		(bits == nil) ifTrue:[
+ 			screen _ DisplayScreen extent: aPoint depth: bitsPerPixel.
+ 			self == Display ifTrue:[
+ 				Display _ screen.
+ 				Display beDisplay].
+ 			^screen].
+ 		width _ aPoint x.
+ 		height _ aPoint y.
+ 	].
+ 	clippingBox _ super boundingBox.
+ 	allocatedForms ifNil:[
+ 		allocatedForms _ ExternalFormRegistry new.
+ 		WeakArray addWeakDependent: allocatedForms].
+ !

Item was added:
+ ----- Method: ExternalScreen>>shutDown (in category 'initialize-release') -----
+ shutDown 
+ 	"Minimize Display memory saved in image"
+ 	self destroy.
+ 	width _ 240.
+ 	height _ 120.
+ 	bits _ Bitmap new: self bitsSize.!

Item was added:
+ ----- Method: ExternalScreen>>supportsDisplayDepth: (in category 'primitives-display') -----
+ supportsDisplayDepth: pixelDepth
+ 	"Return true if this pixel depth is supported on the current host platform."
+ 	^false!

Item was added:
+ Object subclass: #ExternalSemaphoreTable
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'ProtectTable'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Support'!
+ 
+ !ExternalSemaphoreTable commentStamp: '<historical>' prior: 0!
+ By John M McIntosh johnmci at smalltalkconsulting.com
+ This class was written to mange the external semaphore table. When I was writing a Socket test server I discovered various race conditions on the access to the externalSemaphore table. This new class uses class side methods to restrict access using a mutex semaphore. It seemed cleaner to deligate the reponsibility here versus adding more code and another class variable to SystemDictionary 
+ 
+ Note that in Smalltalk recreateSpecialObjectsArray we still directly play with the table.!

Item was added:
+ ----- Method: ExternalSemaphoreTable class>>clearExternalObjects (in category 'accessing') -----
+ clearExternalObjects
+ 	"Clear the array of objects that have been registered for use in non-Smalltalk code."
+ 
+ 	ProtectTable critical: [Smalltalk specialObjectsArray at: 39 put: Array new].
+ !

Item was added:
+ ----- Method: ExternalSemaphoreTable class>>externalObjects (in category 'accessing') -----
+ externalObjects
+ 	^ProtectTable critical: [Smalltalk specialObjectsArray at: 39].!

Item was added:
+ ----- Method: ExternalSemaphoreTable class>>initialize (in category 'initialize') -----
+ initialize
+ 	ProtectTable _ Semaphore forMutualExclusion!

Item was added:
+ ----- Method: ExternalSemaphoreTable class>>registerExternalObject: (in category 'accessing') -----
+ registerExternalObject: anObject
+ 	^ ProtectTable critical: [self safelyRegisterExternalObject: anObject]
+ !

Item was added:
+ ----- Method: ExternalSemaphoreTable class>>safelyRegisterExternalObject: (in category 'accessing') -----
+ safelyRegisterExternalObject: anObject
+ 	"Register the given object in the external objects array and return its index. If it is already there, just return its index."
+ 
+ 	| objects firstEmptyIndex obj sz newObjects |
+ 	objects _ Smalltalk specialObjectsArray at: 39.
+ 
+ 	"find the first empty slot"
+ 	firstEmptyIndex _ 0.
+ 	1 to: objects size do: [:i |
+ 		obj _ objects at: i.
+ 		obj == anObject ifTrue: [^ i].  "object already there, just return its index"
+ 		(obj == nil and: [firstEmptyIndex = 0]) ifTrue: [firstEmptyIndex _ i]].
+ 
+ 	"if no empty slots, expand the array"
+ 	firstEmptyIndex = 0 ifTrue: [
+ 		sz _ objects size.
+ 		newObjects _ objects species new: sz + 20.  "grow linearly"
+ 		newObjects replaceFrom: 1 to: sz with: objects startingAt: 1.
+ 		firstEmptyIndex _ sz + 1.
+ 		Smalltalk specialObjectsArray at: 39 put: newObjects.
+ 		objects _ newObjects].
+ 
+ 	objects at: firstEmptyIndex put: anObject.
+ 	^ firstEmptyIndex
+ !

Item was added:
+ ----- Method: ExternalSemaphoreTable class>>safelyUnregisterExternalObject: (in category 'accessing') -----
+ safelyUnregisterExternalObject: anObject
+ 	"Unregister the given object in the external objects array. Do nothing if it isn't registered.
+ 	JMM change to return if we clear the element, since it should only appear once in the array"
+ 
+ 	| objects |
+ 	anObject ifNil: [^ self].
+ 	objects _ Smalltalk specialObjectsArray at: 39.
+ 	1 to: objects size do: [:i |
+ 		(objects at: i) == anObject ifTrue: 
+ 		[objects at: i put: nil.
+ 		^self]].
+ !

Item was added:
+ ----- Method: ExternalSemaphoreTable class>>unregisterExternalObject: (in category 'accessing') -----
+ unregisterExternalObject: anObject
+ 	ProtectTable critical: [self safelyUnregisterExternalObject: anObject]
+ !

Item was added:
+ TextInput subclass: #FileInput
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Forms'!
+ 
+ !FileInput commentStamp: '<historical>' prior: 0!
+ An input field for <INPUT TYPE="file">
+ Support for uploading files using HTTP/multipart forms
+ Appearance/behavior as in NS/MS browsers
+ (i.e., separate filename entry box and browse files button)!

Item was added:
+ ----- Method: FileInput class>>name:textMorph: (in category 'instance creation') -----
+ name: aString textMorph: aTextMorph
+ 	^self name: aString defaultValue: '' textMorph: aTextMorph!

Item was added:
+ ----- Method: FileInput>>browse (in category 'accessing') -----
+ browse
+ 	| file |
+ 	file _ (StandardFileMenu oldFileFrom: self directory) ifNil: [^nil].
+ 	file directory isNil ifTrue: [^ nil].
+ 
+ 	textMorph setText: (file directory pathName, FileDirectory slash, file name);
+ 		hasUnacceptedEdits: true;
+ 		accept!

Item was added:
+ ----- Method: FileInput>>directory (in category 'accessing') -----
+ directory
+ 	^FileDirectory forFileName: self filename!

Item was added:
+ ----- Method: FileInput>>filename (in category 'accessing') -----
+ filename
+ 	textMorph hasUnacceptedEdits ifTrue: [ textMorph accept ].
+ 	^textMorph getText asString withInternetLineEndings!

Item was added:
+ ----- Method: FileInput>>localFilename (in category 'accessing') -----
+ localFilename
+ 	^FileDirectory localNameFor: self filename!

Item was added:
+ ----- Method: FileInput>>url (in category 'accessing') -----
+ url
+ 	^FileUrl pathParts: ((self directory pathParts) copyWith: self localFilename)!

Item was added:
+ ----- Method: FileInput>>value (in category 'accessing') -----
+ value
+ 	^MIMEDocument contentType: (MIMEDocument guessTypeFromName: self filename)
+ 		content: nil
+ 		url: self url!

Item was added:
+ ----- Method: FileList>>removeVersionNumberFromFileName (in category '*Etoys-Squeakland-file menu action') -----
+ removeVersionNumberFromFileName
+ 	"The selected filename has a version number in it.  Rename the file  such that the version number is removed."
+ 
+ 	| localName fullName dotPosition beforeDot earlierDotPosition within newLocalName |
+ 
+ 	fullName := directory fullNameFor: fileName.
+ 	localName := FileDirectory localNameFor: fullName.
+ 	dotPosition := localName  findLastOccuranceOfString: FileDirectory dot  startingAt: 1.
+ 	dotPosition > 0 ifTrue:
+ 		[beforeDot := localName copyFrom: 1 to: dotPosition - 1.
+ 		earlierDotPosition := beforeDot findLastOccuranceOfString: FileDirectory dot startingAt: 1.
+ 		earlierDotPosition > 0 ifTrue:
+ 			[within := beforeDot copyFrom: (earlierDotPosition + 1) to: beforeDot size.
+ 			(within size > 0 and: [within isAllDigits]) ifTrue:
+ 				["whew"
+ 				newLocalName := (localName copyFrom: 1 to: (earlierDotPosition - 1)),
+ 					(localName copyFrom: dotPosition to: localName size).
+ 				(directory fileNames includes: newLocalName)
+ 					ifTrue:
+ 						[(self confirm: ('do you want to clobber the existing' translated, '
+ ', newLocalName, '?') orCancel: [^ self]) ifFalse: [^ self].
+ 						directory deleteFileNamed: localName].
+ 				directory rename: localName toBe: newLocalName.
+ 				self updateFileList]]].
+ !

Item was added:
+ ----- Method: FileList>>serviceRemoveVersionNumber (in category '*Etoys-Squeakland-own services') -----
+ serviceRemoveVersionNumber
+ 	"Answer a service for removing a version number of the form  .mmm. from a file name."
+ 
+ 	^ SimpleServiceEntry
+ 		provider: self 
+ 		label: 'remove version number from file name' translatedNoop
+ 		selector: #removeVersionNumberFromFileName
+ 		description: 'remove version number from filename' translatedNoop
+ 		buttonLabel: 'remove version #' translatedNoop!

Item was added:
+ ----- Method: FileList2 class>>buildButtonText:balloonText:receiver:selector: (in category '*Etoys-Squeakland-blue ui') -----
+ buildButtonText: aString balloonText: balloonText receiver: anObject selector: aSymbol 
+ 	| aButton |
+ 	aButton := SimpleButtonMorph new.
+ 	aButton label: aString font: self fontForBlueFileListButtons.
+ 	aButton color: ScriptingSystem baseColor.
+ 	aButton target: anObject.
+ 	aButton actionSelector: aSymbol.
+ 	aButton setBalloonText: balloonText.
+ 	^ aButton!

Item was added:
+ ----- Method: FileList2 class>>buildFileListDirFilterType: (in category '*Etoys-Squeakland-blue ui') -----
+ buildFileListDirFilterType: aSymbol 
+ 	| aFileList |
+ 	aFileList := self new directory: FileDirectory default.
+ 	aFileList
+ 		fileSelectionBlock: (aSymbol == #limitedSuperSwikiDirectoryList
+ 				ifTrue: [MessageSend receiver: self selector: #projectOnlySelectionMethod:]
+ 				ifFalse: [self projectOnlySelectionBlock]).
+ 	^ aFileList!

Item was added:
+ ----- Method: FileList2 class>>buildFileTypeButtons:actionRow:fileList: (in category '*Etoys-Squeakland-blue ui') -----
+ buildFileTypeButtons: window actionRow: actionRow fileList: aFileList 
+ 	| fileTypeInfo fileTypeButtons fileTypeRow aButton |
+ 	fileTypeInfo := self endingSpecs.
+ 	fileTypeRow := window addARowCentered: #().
+ 	fileTypeRow color: ScriptingSystem paneColor.
+ 	fileTypeRow layoutInset: 3 @ 3.
+ 	fileTypeRow cellInset: 2 @ 0.
+ 	fileTypeRow hResizing: #spaceFill.
+ 	fileTypeButtons := fileTypeInfo
+ 				collect: [:each | 
+ 					aButton := self
+ 								buildButtonText: each first
+ 								balloonText: nil
+ 								receiver: aFileList
+ 								selector: #update:fileTypeRow:morphUp:.
+ 					aButton arguments: {actionRow. fileTypeRow. aButton}.
+ 					aButton setProperty: #enabled toValue: true.
+ 					aButton setProperty: #buttonText toValue: each first.
+ 					aButton].
+ 	fileTypeRow addAllMorphs: fileTypeButtons.
+ 	aFileList directoryChangeBlock: [:newDir | self
+ 			enableTypeButtons: fileTypeButtons
+ 			info: fileTypeInfo
+ 			forDir: newDir] fixTemps.
+ !

Item was added:
+ ----- Method: FileList2 class>>buildLoadButtons:fileList:reallyLoad: (in category '*Etoys-Squeakland-blue ui') -----
+ buildLoadButtons: window fileList: aFileList reallyLoad: aBoolean 
+ 	| aRow  okButton cancelButton |
+ 	okButton := self
+ 				buildButtonText: 'OK' translated
+ 				balloonText: nil
+ 				receiver: aFileList
+ 				selector: (aBoolean
+ 						ifTrue: [#okHitForProjectLoader]
+ 						ifFalse: [#okHit]).
+ 	okButton width: 150.
+ 	cancelButton := self
+ 				buildButtonText: 'Cancel' translated
+ 				balloonText: nil
+ 				receiver: aFileList
+ 				selector: #cancelHit.
+ 	cancelButton width: 150.
+ 
+ 	"aFileList updateLoginButtonAppearance."
+ 
+ 	aRow := window addARow: {aFileList loginButton. aFileList loginField. okButton. cancelButton}.
+ 	aRow color: ScriptingSystem paneColor.
+ 	aRow listCentering: #bottomRight.
+ 	aRow layoutInset: 3 @ 3.
+ 	aRow cellInset: 6 @ 3.
+ 	^ aRow!

Item was added:
+ ----- Method: FileList2 class>>buildMorphicWindow:title: (in category '*Etoys-Squeakland-blue ui') -----
+ buildMorphicWindow: aFileList title: aString 
+ 	| window |
+ 	window := ScriptingSystem buildPanelTitled: aString.
+ 	window setProperty: #FileList toValue: aFileList.
+ 	aFileList modalView: window.
+ 	window becomeModal.
+ 	^ window!

Item was added:
+ ----- Method: FileList2 class>>buildPane:fileList:window:dirFilterType: (in category '*Etoys-Squeakland-blue ui') -----
+ buildPane: aWorld fileList: aFileList window: window dirFilterType: aSymbol 
+ 	| treeExtent filesExtent treePane fileListPane pane2a pane2b aRow |
+ 	aWorld width < 800
+ 		ifTrue: [treeExtent := 150 @ 300.
+ 			filesExtent := 350 @ 300]
+ 		ifFalse: [treeExtent := 250 @ 300.
+ 			filesExtent := 350 @ 300].
+ 	(treePane := aFileList morphicDirectoryTreePaneFiltered: aSymbol) extent: treeExtent;
+ 		 retractable: false;
+ 		 borderWidth: 0.
+ 	fileListPane := aFileList morphicFileListPane extent: filesExtent;
+ 				 retractable: false;
+ 				 borderWidth: 0.
+ 	aRow := window addARow: {(window inAColumn: {(pane2a := window inARow: {window inAColumn: {treePane}}) useRoundedCornersInEtoys; layoutInset: 3})
+ 					layoutInset: 3. (window inAColumn: {(pane2b := window inARow: {window inAColumn: {fileListPane}}) useRoundedCornersInEtoys; layoutInset: 3})
+ 					layoutInset: 3}.
+ 	aRow color: ScriptingSystem paneColor.
+ 	window fullBounds.
+ 	{pane2a. pane2b}
+ 		do: [:each | 
+ 			each borderWidth: 1.
+ 			each borderColor: ScriptingSystem borderColor].
+ 	^ treePane.!

Item was added:
+ ----- Method: FileList2 class>>buildSaveButtons:fileList: (in category '*Etoys-Squeakland-blue ui') -----
+ buildSaveButtons: window fileList: aFileList
+ 	| buttonData buttons aRow |
+ 	buttonData := Preferences enableLocalSave
+ 				ifTrue: [#(#('Save' #okHit 'Save in the place specified above')
+ 							#('Save on local disk only' #saveLocalOnlyHit 'saves in the Squeaklets folder')
+ 							#('Cancel' #cancelHit 'return without saving') ) translatedNoop]
+ 				ifFalse: [#(#('Save' #okHit 'Save in the place specified above')
+ 							#('Cancel' #cancelHit 'return without saving') ) translatedNoop].
+ 	buttons := buttonData
+ 				collect: [:each | self
+ 						buildButtonText: each first translated
+ 						balloonText: each third translated
+ 						receiver: aFileList
+ 						selector: each second].
+ 	aFileList updateLoginButtonAppearance.
+ 	buttons := {aFileList loginButton. aFileList loginField. Morph new color: Color transparent; width: 50}, buttons.
+ 	aRow := window addARow: buttons.
+ 	aRow color: ScriptingSystem paneColor.
+ 	aRow listCentering: #bottomRight.
+ 	aRow layoutInset: 3 @ 3.
+ 	aRow cellInset: 6 @ 3.
+ 	^ aRow!

Item was added:
+ ----- Method: FileList2 class>>findAProjectSimple (in category '*Etoys-Squeakland-blue ui') -----
+ findAProjectSimple
+ 	"self findAProjectSimple"
+ 	^ self
+ 		morphicViewProjectLoader2InWorld: World
+ 		reallyLoad: true
+ 		dirFilterType: #limitedSuperSwikiDirectoryList!

Item was added:
+ ----- Method: FileList2 class>>fontForBlueFileListButtons (in category '*Etoys-Squeakland-blue ui') -----
+ fontForBlueFileListButtons
+ 	"Answer the font to use in the buttons of the blue file-list dialogs used by olpc users of etoys."
+ 
+ 	^  Preferences standardEToysFont!

Item was added:
+ ----- Method: FileList2 class>>fontForBlueFileListTitle (in category '*Etoys-Squeakland-blue ui') -----
+ fontForBlueFileListTitle
+ 	"Answer the largest font to use in the blue file-list dialogs used by olpc users of etoys."
+ 
+ 	^ Preferences parameterAt: #fontForBlueFileListTitle ifAbsentPut: [(StrikeFont familyName: 'Accujen' size: 30) emphasized: 1]!

Item was added:
+ ----- Method: FileList2 class>>morphicViewProjectLoader2InWorld:title:reallyLoad:dirFilterType:isGeneral: (in category '*Etoys-Squeakland-blue ui') -----
+ morphicViewProjectLoader2InWorld: aWorld title: title reallyLoad: aBoolean dirFilterType: aSymbol isGeneral: isGeneral
+ 	"Put up a blue file-list for loading etoy projects."
+ "
+ FileList2 morphicViewProjectLoader2InWorld: self currentWorld reallyLoad: true dirFilterType: #limitedSuperSwikiDirectoryList
+ "
+ 
+ 	| window aFileList actionRow treePane p |
+ 
+ 	aFileList _ self buildFileListDirFilterType: aSymbol.
+ 	window := self buildMorphicWindow: aFileList title: title. 
+ 
+ 	actionRow _ self buildLoadButtons: window fileList: aFileList reallyLoad: aBoolean.
+ 
+ 	isGeneral
+ 		ifTrue: [self buildFileTypeButtons: window actionRow: actionRow fileList: aFileList].
+ 
+ 	treePane := self buildPane: aWorld fileList: aFileList window: window dirFilterType: aSymbol.
+ 	window addMorphBack: actionRow.
+ 
+ 	window fullBounds.
+ 	window position: aWorld topLeft + (aWorld extent - window extent // 2).
+ 	window beSticky.
+ 	aFileList sortByName.
+ 	"This crazy stuff I really cannot figure out how to get the directory selected by default other than this."
+ 	(treePane scroller submorphs detect: [:e |
+ 		p := e complexContents withoutListWrapper pathName.
+ 		(p beginsWith: 'sugar://') or: [p = SecurityManager default untrustedUserDirectory]] ifNone: [nil])
+ 			ifNotNilDo: [:item | WorldState addDeferredUIMessage: [aFileList setSelectedDirectoryTo: item complexContents]].
+ 	aFileList postOpen.
+ 	^ window!

Item was added:
+ ----- Method: FileList2>>buildButtonForService: (in category '*Etoys-Squeakland-user interface') -----
+ buildButtonForService: aService 
+ 	"Answer a button to trigger the given service in the file-list."
+ 	| aButton |
+ 	aButton := SimpleButtonMorph new.
+ 	aButton label: aService buttonLabel capitalized translated font: self class fontForBlueFileListButtons.
+ 	aButton color: ScriptingSystem baseColor.
+ 	aButton actWhen: #buttonUp.
+ 	aButton target: aService.
+ 	aButton actionSelector: #performServiceFor:.
+ 	aButton arguments: {self}.
+ 	aButton setBalloonText: aService label translated.
+ 	^ aButton!

Item was added:
+ ----- Method: FileList2>>initialDirectoryListForProjects (in category '*Etoys-Squeakland-initialization') -----
+ initialDirectoryListForProjects
+ 
+ 	| dir nameToShow dirList |
+ 	dirList _ (FileDirectory on: '') directoryNames collect: [ :each |
+ 		FileDirectoryWrapper with: (FileDirectory on: each) name: each model: self].
+ 
+ 	dirList isEmpty ifTrue:[
+ 		dirList _ Array with: (FileDirectoryWrapper 
+ 			with: FileDirectory default 
+ 			name: FileDirectory default localName 
+ 			model: self)].
+ 	dirList do: [:e | e balloonText: e withoutListWrapper pathName].
+ 	dirList _ dirList,((
+ 		ServerDirectory serverNames select: [ :n | 
+ 			(ServerDirectory serverNamed: n) isProjectSwiki.
+ 		]) collect: [:n |
+ 			dir _ ServerDirectory serverNamed: n.
+ 			nameToShow _ n.
+ 			(dir directoryWrapperClass with: dir name: nameToShow model: self)
+ 				balloonText: dir realUrl
+ 		]
+ 	).
+ 	^dirList!

Item was added:
+ ----- Method: FileList2>>loginButton (in category '*Etoys-Squeakland-private') -----
+ loginButton
+ 
+ 	^ loginButton
+ !

Item was added:
+ ----- Method: FileList2>>loginButton: (in category '*Etoys-Squeakland-private') -----
+ loginButton: aButton
+ 
+ 	loginButton := aButton.
+ !

Item was added:
+ ----- Method: FileList2>>loginField (in category '*Etoys-Squeakland-private') -----
+ loginField
+ 
+ 	^ loginField!

Item was added:
+ ----- Method: FileList2>>loginHit (in category '*Etoys-Squeakland-private') -----
+ loginHit
+ 
+ 	| s failed ret |
+ 	loginDialog ifNotNil: [^ false].
+ 	s := ServerDirectory servers at: 'My Squeakland' ifAbsent: [^ false].
+ 	failed := [Utilities loggedIn: false. loginDialog := nil. s user: nil].
+ 	ret := true.
+ 	loginDialog := EtoyDAVLoginMorph new.
+ 	loginDialog loginAndDo: [:n :p |
+ 		s ifNotNil: [
+ 			s user: n.
+ 			s password: p.
+ 			[s copy createPersonalDirectory: n] on: Error do: [:ex |
+ 				"either directory already exists or could not create.
+ 				Here, it is just eaten as the following test will tell us whether it can be read."].
+ 			[s entries] on: ProtocolClientError,  NetworkError do: [:ex |
+ 				failed value. self inform: 'Login failed.'. ret := false].
+ 			ret ifTrue: [Utilities authorName: n. Utilities loggedIn: true]].
+ 		self updateLoginButtonAppearance.
+ 		Utilities loggedIn ifTrue: [
+ 			self directory: directory.
+ 			brevityState := #FileList.
+ 			"self addPath: path."
+ 			self changed: #fileList.
+ 			self changed: #contents.
+ 			self changed: #currentDirectorySelected.
+ 			EToyProjectDetailsMorph updateTripletsFromWebSiteInBackground.
+ 		].
+ 		loginDialog := nil. 
+ 		true.
+ 	] ifCanceled: failed.
+ !

Item was added:
+ ----- Method: FileList2>>logoutHit (in category '*Etoys-Squeakland-private') -----
+ logoutHit
+ 
+ 	| s |
+ 	s := ServerDirectory servers at: 'My Squeakland' ifAbsent: [^ false].
+ 	Utilities loggedIn: false. s user: nil.
+ 	self updateLoginButtonAppearance
+ !

Item was added:
+ ----- Method: FileList2>>update:fileTypeRow:morphUp: (in category '*Etoys-Squeakland-user interface') -----
+ update: actionRow fileTypeRow: fileTypeRow morphUp: morph
+ 	"Update a row of action buttons."
+ 
+ 	| fileTypeInfo info2 buttons fileSuffixes fileActions fileTypeString |
+ 
+ 	(morph valueOfProperty: #enabled) ifFalse: [^self].
+ 	fileTypeRow submorphsDo: [ :sub |
+ 		(sub findA: StringMorph) color: Color black.
+ 		sub == morph
+ 			ifTrue: [sub color: (ScriptingSystem baseColor mixed: 1/2 with: Color white)]
+ 			ifFalse:
+ 				[(sub valueOfProperty: #enabled)
+ 					ifTrue:
+ 						[sub color: ScriptingSystem baseColor]
+ 					ifFalse:
+ 						[sub color: Color transparent.
+ 						(sub findA: StringMorph) color: (Color gray: 0.8).
+ 						]]].
+ 
+ 	fileTypeString _ morph valueOfProperty: #buttonText.
+ 
+ 	actionRow removeAllMorphs.
+ 	fileTypeInfo _ self class endingSpecs.
+ 	info2 _ fileTypeInfo
+ 		detect: [ :each | each first = fileTypeString]
+ 		ifNone: [self error: 'bad fileTypeString' ].
+ 	fileSuffixes _ info2 second.
+ 	fileActions _ info2 third.
+ 	buttons _ fileActions collect: [ :each | self buildButtonForService: each ].
+ 	buttons addLast: (self class buildButtonText: 'Cancel' translated balloonText: 'Cancel this search' translated receiver: self selector: #cancelHit).
+ 	buttons do: [ :each | actionRow addMorphBack: each].
+ 
+ 	self fileSelectionBlock: (
+ 		self class selectionBlockForSuffixes: (fileSuffixes collect: [ :each | '*.',each])
+ 	).
+ 	self updateFileList!

Item was added:
+ ----- Method: FileList2>>updateLoginButtonAppearance (in category '*Etoys-Squeakland-private') -----
+ updateLoginButtonAppearance
+ 
+ 	| old oldField notLoggedInMessage |
+ 	notLoggedInMessage := '(not logged in)' translated.
+ 	old := loginButton.
+ 	oldField := loginField.
+ 	loginField := Morph new color: Color white.
+ 	loginField borderWidth: 2.
+ 	loginField borderColor: ScriptingSystem baseColor.
+ 	loginField beSticky.
+ 	loginField width: 150.
+ 	loginField height: 30.
+ 	loginField clipSubmorphs: true.
+ 	Utilities loggedIn ifTrue: [
+ 		loginButton := self class
+ 					buildButtonText: 'Logout' translated
+ 					balloonText: nil
+ 					receiver: self
+ 					selector: #logoutHit.
+ 		loginButton color: ScriptingSystem baseColor.
+ 		loginField addMorphCentered: (StringMorph contents: (Utilities authorNamePerSe ifNil: [notLoggedInMessage]) font: Preferences standardEToysButtonFont).
+ 		loginButton setBalloonText: 'Log out from the Squeakland server' translated.
+ 		loginField setBalloonText: 'Your Squeakland user name' translated.
+ 	]
+ 	ifFalse: [
+ 		loginButton := self class
+ 					buildButtonText: 'Login' translated
+ 					balloonText: nil
+ 					receiver: self
+ 					selector: #loginHit.
+ 		loginButton color: ScriptingSystem baseColor.
+ 		loginField addMorphCentered: (StringMorph contents: notLoggedInMessage font: Preferences standardEToysButtonFont).
+ 		loginButton setBalloonText: 'Log in to share projects on the Squeakland server' translated.
+ 		loginField setBalloonText: 'Your Squeakland user name' translated
+ 	].
+ 	loginButton setNamePropertyTo: 'login'.
+ 	loginButton width: 150.
+ 	old ifNotNil: [
+ 		old owner addMorph: loginButton inFrontOf: old.
+ 		old delete].
+ 	oldField ifNotNil: [
+ 		oldField owner addMorph: loginField inFrontOf: oldField.
+ 		oldField delete].
+ !

Item was added:
+ ----- Method: FilePath>>coverter: (in category '*Etoys-Squeakland-conversion') -----
+ coverter: aTextConverter
+ 
+ 	converter class ~= aTextConverter class ifTrue: [
+ 		converter _ aTextConverter.
+ 		vmPathName _ squeakPathName convertToWithConverter: converter
+ 	].
+ !

Item was added:
+ ----- Method: FileStream class>>closeStandardStreams (in category '*Etoys-Squeakland-standard streams') -----
+ closeStandardStreams
+ 	StdIn ifNotNil: [StdIn close. StdIn := nil].
+ 	StdOut ifNotNil: [StdOut close. StdOut := nil].
+ 	StdErr ifNotNil: [StdErr close. StdErr := nil].
+ !

Item was added:
+ ----- Method: FillInTheBlankMorph class>>request:initialAnswer:onCancelReturn: (in category '*Etoys-Squeakland-instance creation') -----
+ request: queryString initialAnswer: defaultAnswer onCancelReturn: cancelResponse
+ 	"Create an instance of me whose question is queryString with the given initial answer. Invoke it centered at the given point, and answer the string the user accepts. Answer the empty string if the user cancels."
+ 	"FillInTheBlankMorph
+ 		request: 'What is your favorite color?'
+ 		initialAnswer: 'red, no blue. Ahhh!!'"
+ 
+ 	^ self
+ 		request: queryString
+ 		initialAnswer: defaultAnswer
+ 		centerAt: ActiveHand cursorPoint
+ 		inWorld: ActiveWorld
+ 		onCancelReturn: cancelResponse!

Item was added:
+ ----- Method: FillInTheBlankMorph>>createQueryTextMorph: (in category '*Etoys-Squeakland-initialization') -----
+ createQueryTextMorph: queryString 
+ 	"create the queryTextMorph"
+ 	| result |
+ 	result := TextMorph new newContents: queryString.
+ 	result setNameTo: 'query' translated.
+ 	result font: Preferences standardMenuFont.
+ 	result releaseParagraphReally.
+ 	result fillStyle: ScriptingSystem baseColor.
+ 	result centered.
+ 	result lock.
+ 	result hResizing: #spaceFill.
+ 	^ result!

Item was added:
+ ----- Method: FillInTheBlankMorph>>createTextPaneAcceptBoolean: (in category '*Etoys-Squeakland-initialization') -----
+ createTextPaneAcceptBoolean: acceptBoolean
+ 	"create the textPane"
+ 	| result |
+ 	result := PluggableTextMorph
+ 				on: self
+ 				text: #response
+ 				accept: #response:
+ 				readSelection: #selectionInterval
+ 				menu: #codePaneMenu:shifted:.
+ 	result hResizing: #spaceFill;
+ 		 vResizing: #spaceFill.
+ 	result borderWidth: 1.
+ 	result borderColor: Preferences menuBorderColor.
+ 	result hasUnacceptedEdits: true.
+ 	result acceptOnCR: acceptBoolean.
+ 	result setNameTo: 'textPane'.
+ 	result font: Preferences standardMenuFont.
+ 	result hideScrollBarsIndefinitely.
+ 	result selectionInterval: nil.
+ 	result selectAll.
+ 	^ result!

Item was added:
+ MagnifierMorph subclass: #FishEyeMorph
+ 	instanceVariableNames: 'gridNum d clipRects toRects quads savedExtent'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Demo'!

Item was added:
+ ----- Method: FishEyeMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName:	'FishEye' translatedNoop
+ 		categories:		#()
+ 		documentation:	'An extreme-wide-angle lens' translatedNoop!

Item was added:
+ ----- Method: FishEyeMorph>>calculateTransform (in category 'initialization') -----
+ calculateTransform
+ 	| stepX stepY rect tx ty arrayX arrayY |
+ 	(gridNum x = 0 or: [gridNum y = 0]) ifTrue: [^self].
+ 	stepX _ srcExtent x // gridNum x.
+ 	stepY _ srcExtent y // gridNum y.
+ 
+ 	arrayX _ (1 to: gridNum y + 1) collect: [:j | FloatArray new: gridNum x + 1].
+ 	arrayY _ (1 to: gridNum y + 1) collect: [:j |  FloatArray new: gridNum x + 1].
+ 
+ 	0 to: gridNum y do: [:j |
+ 		0 to: gridNum x do: [:i |
+ 			(arrayX at: (j + 1)) at: (i + 1) put: i*stepX.
+ 			(arrayY at: (j + 1)) at: (i + 1) put: j*stepY.
+ 		].
+ 	].
+ 
+ 	0 to: gridNum y do: [:j |
+ 		self transformX: (arrayX at: (j+1)).
+ 		self transformY: (arrayY at: (j+1)).
+ 	].
+ 
+ 	0 to: gridNum y do: [:j |
+ 		arrayX at: (j+1) put: ((1 to: gridNum x +1) collect: [:i | ((arrayX at: (j+1)) at: i) asInteger]).
+ 		arrayY at: (j+1) put: ((1 to: gridNum x +1) collect: [:i | ((arrayY at: (j+1)) at: i) asInteger]).
+ 	].
+ 
+ 
+ 	clipRects _ (1 to: gridNum y) collect: [:j | Array new: gridNum x].
+ 	toRects _ (1 to: gridNum y) collect: [:j |  Array new: gridNum x].
+ 	quads _ (1 to: gridNum y) collect: [:j |  Array new: gridNum x].
+ 	0 to: gridNum y - 1 do: [:j |
+ 		0 to: gridNum x- 1 do: [:i |
+ 			rect _ (((arrayX at: (j+1)) at: (i+1))@((arrayY at: (j+1)) at: (i+1)))
+ 						corner: ((arrayX at: (j+2)) at: (i+2))@((arrayY at: (j+2)) at: (i+2)).
+ 			(clipRects at: j+1) at: i+1 put: rect.
+ 
+ 			rect width >= stepX ifTrue: [rect _ rect expandBy: (1 at 0)].
+ 			rect height >= stepY ifTrue: [rect _ rect expandBy: (0 at 1)].
+ 			(toRects at: j+1) at: i+1 put: rect.
+ 
+ 			tx _ (i)*stepX.
+ 			ty _ (j)*stepY.
+ 			(quads at: j+1) at: i+1
+ 						put: {(tx)@(ty). (tx)@(ty+stepY). (tx+stepX)@(ty+stepY). (tx+stepX)@(ty)}.
+ 		].
+ 	].
+ 
+ !

Item was added:
+ ----- Method: FishEyeMorph>>chooseMagnification (in category 'menus') -----
+ chooseMagnification
+ 	self inform: 'Magnification is fixed, sorry.' translated!

Item was added:
+ ----- Method: FishEyeMorph>>chooseMagnification: (in category 'menu') -----
+ chooseMagnification: evt
+ !

Item was added:
+ ----- Method: FishEyeMorph>>extent: (in category 'geometry') -----
+ extent: aPoint
+ 	"Round to a number divisible by grid.  Note that the superclass has its own implementation."
+ 	| g gridSize |
+ 	gridSize _ self gridSizeFor: aPoint.
+ 	"self halt."
+ 	g _ (aPoint - (2 * borderWidth)) // gridSize.
+ 	srcExtent _ g * gridSize.
+ 	gridNum _ g.
+ 	^super extent: self defaultExtent!

Item was added:
+ ----- Method: FishEyeMorph>>g:max:focus: (in category 'initialization') -----
+ g: aFloatArray max: max focus: focus
+ 	| dNormX array |
+ 
+ 	dNormX _ aFloatArray - focus.
+ 	
+ 	array _ dNormX / max.
+ 	array *= d.
+ 	array += 1.0.
+ 	array _ 1.0 / array.
+ 	dNormX *= (d+1.0).
+ 	array *= dNormX.
+ 	^array += focus.
+ !

Item was added:
+ ----- Method: FishEyeMorph>>gridSizeFor: (in category 'private') -----
+ gridSizeFor: aPoint
+ 	"returns appropriate size for specified argument"
+ 	| g |
+ 	g _ aPoint x min: aPoint y.
+ 	g <= 256 ifTrue: [^8].
+ 	^16.!

Item was added:
+ ----- Method: FishEyeMorph>>initialize (in category 'initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ 	super initialize.
+ ""
+ 	"magnification should be always 1"
+ 	magnification _ 1.
+ 	d _ 1.3.
+ 	self extent: 130 @ 130!

Item was added:
+ ----- Method: FishEyeMorph>>initializeToStandAlone (in category 'parts bin') -----
+ initializeToStandAlone
+ 	super initializeToStandAlone.
+ 	"magnification should be always 1"
+ 	magnification _ 1.
+ 	d _ 1.3.
+ 	self extent: 130 at 130.
+ !

Item was added:
+ ----- Method: FishEyeMorph>>magnifiedForm (in category 'magnifying') -----
+ magnifiedForm
+ 	| warp warpForm fromForm |
+ 
+ 	savedExtent ~= srcExtent ifTrue: [
+ 		savedExtent _ srcExtent.
+ 		self calculateTransform].
+ 
+ 	warpForm _ Form extent: srcExtent depth: Display depth.
+ 	fromForm _ super magnifiedForm.
+ 
+ 	warp _  (WarpBlt current toForm: warpForm)
+ 		sourceForm: fromForm;
+ 		colorMap: nil;
+ 		cellSize: 2;
+ 		combinationRule: Form over.
+ 
+ 	1 to: gridNum y do: [:j |
+ 		1 to: gridNum x do: [:i |
+ 			warp
+ 				clipRect: ((clipRects at: j) at: i);
+ 				copyQuad: ((quads at: j) at: i)
+ 					toRect: ((toRects at: j) at: i).
+ 		].
+ 	].
+ 	^warpForm
+ !

Item was added:
+ ----- Method: FishEyeMorph>>transformX: (in category 'initialization') -----
+ transformX: aFloatArray
+ 	| focus gridNum2 subArray dMaxX |
+ 
+ 	focus _ srcExtent x asFloat / 2.
+ 
+ 	gridNum2 _ (aFloatArray findFirst: [:x | x > focus]) - 1.
+ 
+ 	dMaxX _ 0.0 - focus.
+ 	subArray _ self g: (aFloatArray copyFrom: 1 to: gridNum2) max: dMaxX focus: focus.
+ 
+ 	aFloatArray replaceFrom: 1 to: gridNum2 with: subArray startingAt: 1.
+ 
+ 
+ 	dMaxX _ focus.    " = (size - focus)"
+ 	subArray _ self g: (aFloatArray copyFrom: gridNum2 + 1 to: gridNum x + 1)
+ 		max: dMaxX focus: focus.
+ 
+ 	aFloatArray replaceFrom: gridNum2 + 1 to: gridNum x + 1 with: subArray startingAt: 1.
+ !

Item was added:
+ ----- Method: FishEyeMorph>>transformY: (in category 'initialization') -----
+ transformY: aFloatArray 
+ 	| focus subArray dMaxY |
+ 	focus := srcExtent y asFloat / 2.
+ 	dMaxY := (aFloatArray first) <= focus 
+ 				ifTrue: [0.0 - focus]
+ 				ifFalse: [focus].
+ 	subArray := self 
+ 				g: (aFloatArray copyFrom: 1 to: gridNum x + 1)
+ 				max: dMaxY
+ 				focus: focus.
+ 	aFloatArray 
+ 		replaceFrom: 1
+ 		to: gridNum x + 1
+ 		with: subArray
+ 		startingAt: 1!

Item was added:
+ ----- Method: FlapTab class>>helpMessage (in category '*Etoys-Squeakland-scripting') -----
+ helpMessage
+ 	^'A flap to hold objects. For example, you can add a description of your project, or keep versions of sketches for later use. Use the flap tab''s halo menu to adjust its properties.' translatedNoop!

Item was added:
+ ----- Method: FlapTab class>>registerInFlapsRegistry (in category '*Etoys-Squeakland-class initialization') -----
+ registerInFlapsRegistry
+ 	"Register the receiver in the system's flaps registry"
+ 	Flaps registerQuad: {#FlapTab. #authoringPrototype. 'Flap' translatedNoop. self helpMessage}
+ 		forFlapNamed: 'Supplies'.!

Item was added:
+ ----- Method: FlapTab>>changeCompactFlap (in category '*Etoys-Squeakland-compact') -----
+ changeCompactFlap
+ 	self makeFlapCompact: self isFlapCompact not.!

Item was added:
+ ----- Method: FlapTab>>changeTabText2: (in category '*Etoys-Squeakland-textual tabs') -----
+ changeTabText2: aString 
+ 
+ 	| label |
+ 	aString isEmptyOrNil ifTrue: [^ self].
+ 	label _ Locale current languageEnvironment class flapTabTextFor: aString in: self.
+ 	label isEmptyOrNil ifTrue: [^ self].
+ 	self assumeString: label
+ 		font: Preferences standardFlapFont
+ 		orientation: (Flaps orientationForEdge: self edgeToAdhereTo)
+ 		color: nil.
+ !

Item was added:
+ ----- Method: FlapTab>>compactFlapString (in category '*Etoys-Squeakland-compact') -----
+ compactFlapString
+ 	"Answe a string describing whether the receiver is currently compact or not."
+ 
+ 	^ (self isFlapCompact
+ 		ifTrue: ['<on>']
+ 		ifFalse: ['<off>']), 'compact flap' translated!

Item was added:
+ ----- Method: FlapTab>>isFlapCompact (in category '*Etoys-Squeakland-compact') -----
+ isFlapCompact
+ 	"Return true if the referent of the receiver represents a 'compact' flap"
+ 	referent layoutPolicy ifNil:[^false].
+ 	referent layoutPolicy isTableLayout ifFalse:[^false].
+ 	referent vResizing == #shrinkWrap ifFalse:[^false].
+ 	^true!

Item was added:
+ ----- Method: FlapTab>>lazyUnhibernate (in category '*Etoys-Squeakland-initialization') -----
+ lazyUnhibernate
+ !

Item was added:
+ ----- Method: FlapTab>>makeFlapCompact: (in category '*Etoys-Squeakland-compact') -----
+ makeFlapCompact: aBool
+ 	"Return true if the referent of the receiver represents a 'compact' flap"
+ 	aBool ifTrue:[
+ 		referent
+ 			layoutPolicy: TableLayout new;
+ 			vResizing: #shrinkWrap;
+ 			hResizing: #shrinkWrap.
+ "			useRoundedCorners".
+ 	] ifFalse:[
+ 		referent
+ 			layoutPolicy: nil;
+ 			vResizing: #rigid;
+ 			useSquareCorners.
+ 	].
+ !

Item was added:
+ ----- Method: FlapTab>>privateDeleteReferent (in category '*Etoys-Squeakland-show & hide') -----
+ privateDeleteReferent
+ 	referent isFlexed
+ 		ifTrue: [referent owner privateDelete]
+ 		ifFalse: [referent privateDelete]!

Item was added:
+ ----- Method: FlapTab>>referentMargin (in category '*Etoys-Squeakland-positioning') -----
+ referentMargin
+ 
+ 	^ referentMargin ifNil: [0 at 0].
+ !

Item was added:
+ ----- Method: FlapTab>>referentMargin: (in category '*Etoys-Squeakland-positioning') -----
+ referentMargin: aPointOrNil
+ 
+ 	referentMargin _ aPointOrNil.
+ !

Item was added:
+ ----- Method: Flaps class>>addAndEnableEToyFlapsWithPreviousEntries: (in category '*Etoys-Squeakland-predefined flaps') -----
+ addAndEnableEToyFlapsWithPreviousEntries: aCollection
+ 	"Initialize the standard default out-of-box set of global flaps.  This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed."
+ 
+ 	| aSuppliesFlap |
+ 	SharedFlapTabs
+ 		ifNotNil: [^ self].
+ 	SharedFlapTabs _ OrderedCollection new.
+ 	aSuppliesFlap _ self newSuppliesFlapFromQuads: self quadsDefiningPlugInSuppliesFlap positioning: #right withPreviousEntries: aCollection.
+ 	aSuppliesFlap referent setNameTo: 'Supplies Flap' translated.  "Per request from Kim Rose, 7/19/02"
+ 	SharedFlapTabs add: aSuppliesFlap.  "The #center designation doesn't quite work at the moment"
+ 	SugarNavigatorBar showSugarNavigator
+ 		ifTrue: [SharedFlapTabs add: self newSugarNavigatorFlap]
+ 		ifFalse: [SharedFlapTabs add: self newNavigatorFlap].
+ 	self enableGlobalFlapWithID: 'Supplies' translated.
+ 	SugarNavigatorBar showSugarNavigator
+ 		ifTrue:
+ 			[self enableGlobalFlapWithID: 'Sugar Navigator Flap' translated.
+ 			(self globalFlapTabWithID: 'Sugar Navigator Flap' translated) ifNotNilDo:
+ 				[:navTab | aSuppliesFlap sugarNavTab: navTab]]
+ 		ifFalse: [self enableGlobalFlapWithID: 'Navigator' translated].
+ 
+ 	SharedFlapsAllowed _ true.
+ 	Project current flapsSuppressed: false.
+ 	^ SharedFlapTabs
+ 
+ "Flaps addAndEnableEToyFlaps"!

Item was added:
+ ----- Method: Flaps class>>destroyFlapDotDotDot (in category '*Etoys-Squeakland-menu commands') -----
+ destroyFlapDotDotDot
+ 	"Prompt the user for a flap, and destroy the one chosen"
+ 
+ 	| aMenu |
+ 	aMenu _ MenuMorph new.
+ 	aMenu title: 'Destroy flap named...' translated.
+ 	self globalFlapTabsIfAny do:
+ 		[:aFlapTab | aMenu add: aFlapTab flapID target: aFlapTab selector: #destroyFlap].
+ 	aMenu popUpInWorld.
+ 
+ 	!

Item was added:
+ ----- Method: Flaps class>>enableClassicEToyFlaps (in category '*Etoys-Squeakland-menu support') -----
+ enableClassicEToyFlaps
+ 	"Start using global flaps, plug-in version, given that they were not present."
+ 
+ 	Cursor wait showWhile:
+ 		[SugarNavigatorBar showSugarNavigator: false.
+ 		self addAndEnableEToyFlaps.
+ 		self sharedFlapsAlongBottom.
+ 		WorldState addDeferredUIMessage:
+ 			[self positionNavigatorAndOtherFlapsAccordingToPreference].
+ 		self enableGlobalFlaps]!

Item was added:
+ ----- Method: Flaps class>>enableDeveloperFlaps (in category '*Etoys-Squeakland-menu support') -----
+ enableDeveloperFlaps
+ 	"Start using the developers' flaps.given that they were not present."
+ 
+ 	Cursor wait showWhile:
+ 		[SugarNavigatorBar showSugarNavigator: false.
+ 		self enableGlobalFlaps.
+ 		WorldState addDeferredUIMessage:
+ 			[self positionNavigatorAndOtherFlapsAccordingToPreference]]!

Item was added:
+ ----- Method: Flaps class>>enableOLPCEToyFlaps (in category '*Etoys-Squeakland-menu support') -----
+ enableOLPCEToyFlaps
+ 	"Start using global flaps, plug-in version, given that they were not present."
+ 
+ 	Cursor wait showWhile:
+ 		[SugarNavigatorBar showSugarNavigator: true.
+ 		self addAndEnableEToyFlaps.
+ 		self enableGlobalFlaps]!

Item was added:
+ ----- Method: Flaps class>>newSugarNavigatorFlap (in category '*Etoys-Squeakland-predefined flaps') -----
+ newSugarNavigatorFlap
+ 
+ 	| nav aFlapTab |
+ 	nav _ (SugarNavigatorBar newWith: SugarLibrary default) addButtons.
+ 
+ 	aFlapTab _ SugarNavTab new.
+ 	aFlapTab setNameTo: 'Sugar Navigator Flap' translated.
+ 
+ 	aFlapTab referent: nav.
+ 	aFlapTab addMorph: nav.
+ 	aFlapTab inboard: false.
+ 	aFlapTab edgeToAdhereTo: #top.
+ 	Preferences useArtificialSweetenerBar ifTrue: [nav configureForSqueakland].
+ 	aFlapTab resistsRemoval: true.
+ 	^ aFlapTab
+ 
+ "Flaps replaceGlobalFlapwithID: 'SugarNavigator' translated "
+ !

Item was added:
+ ----- Method: Flaps class>>newSuppliesFlapFromQuads:positioning:withPreviousEntries: (in category '*Etoys-Squeakland-predefined flaps') -----
+ newSuppliesFlapFromQuads: quads positioning: positionSymbol withPreviousEntries: aCollection
+ 	"Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen.  Use #center as the positionSymbol to have it centered at the bottom of the screen, or #right to have it placed off near the right edge."
+ 
+ 	|  aFlapTab aStrip aWidth sugarNavigator |
+ 	sugarNavigator _ SugarNavigatorBar showSugarNavigator.
+ 	aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color gray muchLighter from: quads withPreviousEntries: aCollection.
+ 	self twiddleSuppliesButtonsIn: aStrip.
+ 	aFlapTab _ (sugarNavigator ifTrue: [SolidSugarSuppliesTab] ifFalse: [FlapTab]) new referent: aStrip beSticky.
+ 	aFlapTab setName: 'Supplies' translated edge: (sugarNavigator ifTrue: [#top] ifFalse: [#bottom]) color: Color red lighter.
+ 	aFlapTab position: (0 @ ActiveWorld sugarAllowance).
+ 	aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
+ 	aFlapTab applyThickness: 20.
+ 
+ 	aWidth := ActiveWorld width.
+ 	aStrip extent: ActiveWorld width @ (76 * (1 + (1350 // aWidth))).
+ 	aStrip beFlap: true.
+ 	aStrip autoLineLayout: true.
+ 	aStrip vResizeToFit: true.
+ 	sugarNavigator ifTrue: [
+ 		aFlapTab useSolidTab.
+ 		aFlapTab height: 20; color:  (Color r: 0.804 g: 0.804 b: 0.804).
+ 	] ifFalse: [
+ 		aFlapTab color:  Color red lighter
+ 	].
+ 	
+ 	^ aFlapTab
+ 
+ "Flaps replaceGlobalFlapwithID: 'Supplies' translated"!

Item was added:
+ ----- Method: Float>>cubeRoot (in category '*Etoys-Squeakland-mathematical functions') -----
+ cubeRoot
+ 	"Answer the cube root of the receiver."
+ 
+ 	^ self sign *  (self abs raisedTo: 1 / 3)
+ 
+ "
+ 8 cubeRoot
+ 0 cubeRoot
+ 1728 cubeRoot
+ 3.14159265 cubeRoot
+ "!

Item was added:
+ ----- Method: Float>>degreeArcTan (in category '*Etoys-Squeakland-mathematical functions') -----
+ degreeArcTan
+ 	"The receiver is the tangent of an angle. Answer the angle measured in degrees."
+ 
+ 	^ self arcTan radiansToDegrees!

Item was added:
+ ----- Method: Float>>degreeTan (in category '*Etoys-Squeakland-mathematical functions') -----
+ degreeTan
+ 	"Answer the tangent of the receiver taken as an angle in degrees."
+ 	
+ 	^ self degreesToRadians tan!

Item was added:
+ ----- Method: Float>>exponent (in category '*Etoys-Squeakland-truncation and round off') -----
+ exponent
+ 	"Primitive. Consider the receiver to be represented as a power of two
+ 	multiplied by a mantissa (between one and two). Answer with the
+ 	SmallInteger to whose power two is raised. Optional. See Object
+ 	documentation whatIsAPrimitive."
+ 
+ 	| positive |
+ 	<primitive: 53>
+ 	self >= 1.0 ifTrue: [^self floorLog: 2].
+ 	self > 0.0
+ 		ifTrue: 
+ 			[positive _ (1.0 / self) exponent.
+ 			self = (1.0 / (1.0 timesTwoPower: positive))
+ 				ifTrue: [^positive negated]
+ 				ifFalse: [^positive negated - 1]].
+ 	self = 0.0 ifTrue: [^-1].
+ 	^self negated exponent!

Item was added:
+ ----- Method: Float>>safeLn (in category '*Etoys-Squeakland-mathematical functions') -----
+ safeLn
+ 	"Answer the natural logarithm of the receiver, safely"
+ 
+ 	self <= 0 ifTrue: [ScriptingSystem reportToUser: 'Ln of a nonpositive number, ' translated, self printString.  ^ 0].
+ 
+ 	^ [self ln] on: FloatingPointException do:
+ 		[:exc |
+ 			ScriptingSystem reportToUser: 'Ln of negative number, ' translated, self printString.
+ 			exc return: 0]!

Item was added:
+ ----- Method: Float>>safeLog (in category '*Etoys-Squeakland-mathematical functions') -----
+ safeLog
+ 	"Answer the base-10 log of the receiver, safely"
+ 
+ 	self <= 0 ifTrue: [ScriptingSystem reportToUser: 'log of a nonpositive number, ' translated, self printString.  ^ 0].
+ 
+ 	 ^ [self log] on: FloatingPointException do:
+ 		[:exc |
+ 			ScriptingSystem reportToUser:'logarithm does not exist' translated.
+ 			exc return: 0]!

Item was added:
+ ----- Method: Float>>safeSquareRoot (in category '*Etoys-Squeakland-mathematical functions') -----
+ safeSquareRoot
+ 	"Answer the square root of the receiver.   If the receiver is negative, answer zero and swallow the error."
+ 
+ 	^ [self sqrt] on: FloatingPointException do: [:exc | ScriptingSystem reportToUser:'square root of negative number' translated.  ^ 0]!

Item was added:
+ ----- Method: Float>>timesTwoPower: (in category '*Etoys-Squeakland-mathematical functions') -----
+ timesTwoPower: anInteger 
+ 	"Primitive. Answer with the receiver multiplied by 2.0 raised
+ 	to the power of the argument.
+ 	Optional. See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 54>
+ 
+ 	anInteger < -29 ifTrue: [^ self * (2.0 raisedToInteger: anInteger)].
+ 	anInteger < 0 ifTrue: [^ self / (1 bitShift: (0 - anInteger)) asFloat].
+ 	anInteger < 30 ifTrue: [^ self * (1 bitShift: anInteger) asFloat].
+ 	^ self * (2.0 raisedToInteger: anInteger)!

Item was added:
+ WatcherWrapper subclass: #FollowingWatcher
+ 	instanceVariableNames: 'attachmentEdge offset'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Scripting Support'!
+ 
+ !FollowingWatcher commentStamp: 'sw 3/7/2012 00:12' prior: 0!
+ A watcher that follows its watchee around.
+ 
+ attachmentEdge:  can be #left, #right #bottom, #top, #topLeft, #topRight, #bottomLeft, #bottomRight, #center)
+ 
+ offset:  (x,y) offset from the nominal attachment point.!

Item was added:
+ ----- Method: FollowingWatcher class>>additionsToViewerCategories (in category 'scripting') -----
+ 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."
+ 
+ 	^ #((basic (
+ 			(slot attachmentOffset  'the amounts by which the position of the watcher should be offset from the nominal attachment point' Point readWrite Player getAttachmentOffset  Player  setAttachmentOffset:)
+ 			(slot attachmentEdge  'The attachment edge -- which edge or corner the watcher should be aligned with' AttachmentEdge readWrite Player getAttachmentEdge  Player  setAttachmentEdge:) 
+ )))!

Item was added:
+ ----- Method: FollowingWatcher>>addCustomMenuItems:hand: (in category 'accessing') -----
+ addCustomMenuItems: aMenu hand: aHand
+ 	"Add morph-specific items to a menu."
+ 
+ 	aMenu addUpdating:  #attachmentEdgeString  action: #chooseAttachmentEdge.
+ 
+ 	aMenu add: ('offset (currently {1})' translated format: {offset printString}) action: #chooseOffset.
+ 	aMenu balloonTextForLastItem: 'fine-tune the position of this watcher relative to its chosen attachment edge' translated!

Item was added:
+ ----- Method: FollowingWatcher>>attachmentEdge (in category 'accessing') -----
+ attachmentEdge
+ 	"Answer the value of attachmentEdge"
+ 
+ 	^ attachmentEdge!

Item was added:
+ ----- Method: FollowingWatcher>>attachmentEdge: (in category 'accessing') -----
+ attachmentEdge: anObject
+ 	"Set the value of attachmentEdge"
+ 
+ 	attachmentEdge := anObject!

Item was added:
+ ----- Method: FollowingWatcher>>attachmentEdgeString (in category 'accessing') -----
+ attachmentEdgeString
+ 	"Answer a string to serve as the wording of the menu item inviting the use to choose the attachment edge."
+ 
+ 	^ 'choose attachment edge (now {1})' translated format: {attachmentEdge asString translated}!

Item was added:
+ ----- Method: FollowingWatcher>>attachmentOffset (in category 'accessing') -----
+ attachmentOffset
+ 	"Answer the amount by which the watcher should be offset from its nominal attachment point near the watchee."
+ 
+ 	^ offset!

Item was added:
+ ----- Method: FollowingWatcher>>attachmentOffset: (in category 'accessing') -----
+ attachmentOffset: anAmount
+ 	"Set the amount by which the watcher should be offset from its nominal attachment point near the watchee."
+ 
+ 	offset := anAmount!

Item was added:
+ ----- Method: FollowingWatcher>>buildForPlayer:getter: (in category 'initialization') -----
+ buildForPlayer: aPlayer getter: aGetter 
+ 	"Build up basic structure"
+ 
+ 	super buildForPlayer: aPlayer getter: aGetter.
+ 	self firstSubmorph beTransparent; borderWidth: 0.
+ 	self beTransparent; borderWidth: 0!

Item was added:
+ ----- Method: FollowingWatcher>>buildReadout: (in category 'initialization') -----
+ buildReadout: aGetter
+ 	"Build and answer a readout for the given getter."
+ 
+ 	| readout |
+ 	readout := super buildReadout: aGetter.
+ 	((readout submorphs size > 0) and: [readout firstSubmorph isKindOf: StringMorph]) ifTrue:
+ 		[readout firstSubmorph font: ScriptingSystem fontForAttachedWatchers; unlock].
+ 	^ readout!

Item was added:
+ ----- Method: FollowingWatcher>>burnishForReplacing (in category 'copying') -----
+ burnishForReplacing
+ 	"Final appearance modifications before the receiver is inserted as a replacement for an earlier version of the watcher. "
+ 
+ 	self allMorphsDo: [:m | (m isKindOf: StringMorph) ifTrue: [m font: ScriptingSystem fontForAttachedWatchers]]!

Item was added:
+ ----- Method: FollowingWatcher>>chooseAttachmentEdge (in category 'accessing') -----
+ chooseAttachmentEdge
+ 	"Put up a menu allowing the user to choose which edge of the object being watched the receiver should attach itself to."
+ 
+ 	| choice |
+ 	choice := (SelectionMenu selections: #(top topRight right bottomRight  bottom bottomLeft left topLeft center)) startUpWithCaption: ('attachment edge
+ currently: ', attachmentEdge translated).
+ 	choice isEmptyOrNil ifFalse:
+ 		[self attachmentEdge: choice]!

Item was added:
+ ----- Method: FollowingWatcher>>chooseOffset (in category 'accessing') -----
+ chooseOffset
+ 	"Allow the user to select a new offset to apply to the positioning of the receiver with respect to the object it follows."
+ 
+ 	| result aPoint |
+ 	result := FillInTheBlank request: 'offset' translated initialAnswer: offset printString.
+ 	result isEmptyOrNil ifTrue: [^ self].
+ 	aPoint := [Compiler evaluate: result] on: Error do: [^ self inform: 'error' translated].
+ 	(aPoint isKindOf: Point) ifFalse: [^ self inform: 'error' translated].
+ 	offset := aPoint!

Item was added:
+ ----- Method: FollowingWatcher>>fancyForPlayer:getter: (in category 'initialization') -----
+ fancyForPlayer: aPlayer getter: aGetter 
+ 	"Configure the receiver to be a 'following' watcher labeled with the variable name but not with the player name."
+ 
+ 	| aLabel |
+ 	self buildForPlayer: aPlayer getter: aGetter.
+ 	aLabel := StringMorph contents: variableName translated , ' = ' font: ScriptingSystem fontForAttachedWatchers.
+ 	aLabel setProperty: #watcherLabel toValue: true.
+ 	self addMorphFront: aLabel!

Item was added:
+ ----- Method: FollowingWatcher>>initialize (in category 'accessing') -----
+ initialize
+ 	"Initialize the receiver."
+ 
+ 	super initialize.
+ 	attachmentEdge := #bottom.
+ 	offset := 0 at 0!

Item was added:
+ ----- Method: FollowingWatcher>>openInWorld (in category 'initialization') -----
+ openInWorld
+ 	"Open the receiver near the watchee, but if possible avoiding attached-watcher locations already in use."
+ 
+ 	| aMorph others |
+ 	super openInWorld.
+ 	self allMorphsDo: [:m | (m isKindOf: StringMorph) ifTrue: [m font: ScriptingSystem fontForAttachedWatchers]].
+ 	(aMorph := player costume) isInWorld ifTrue:
+ 		[others := aMorph owner submorphs
+ 			select:
+ 				[:m | m ~~ self and: [m isKindOf: self class] and: [m associatedPlayer == player]]
+ 			thenCollect:
+ 				[:m | m attachmentEdge].
+ 		attachmentEdge := #(bottom left top right topLeft topRight bottomRight bottomLeft) detect:
+ 			[:edge | (others includes: edge) not] ifNone: [#bottom]]!

Item was added:
+ ----- Method: FollowingWatcher>>prospectiveReplacement (in category 'copying') -----
+ prospectiveReplacement
+ 	"Answer another watcher of the same class which will serve as the replacement for the receiver.  This is used when the whole apparatus needs to be rebuilt after, for example, a type change or a name change."
+ 
+ 	| replacement |
+ 	replacement := super prospectiveReplacement.
+ 	replacement attachmentEdge: attachmentEdge.
+ 	replacement attachmentOffset: offset.
+ 	^ replacement!

Item was added:
+ ----- Method: FollowingWatcher>>step (in category 'stepping') -----
+ step
+ 	"Periodic activity:  follow watchee round."
+ 
+ 	| itsCostume morphToMove itsPlayfield |
+ 	super step.
+ 	(itsCostume := player costume) isInWorld ifTrue:
+ 		[((morphToMove := self topRendererOrSelf) owner == (itsPlayfield := itsCostume owner))  ifFalse:
+ 			[itsPlayfield addMorphFront: morphToMove].
+ 		morphToMove center: itsCostume center.
+ 
+ 		(#(bottomLeft bottom bottomRight) includes: attachmentEdge) ifTrue:
+ 			[morphToMove top: itsCostume bottom].
+ 		(#(topLeft top topRight) includes: attachmentEdge) ifTrue:
+ 			[morphToMove bottom: itsCostume top].
+ 		(#(topLeft left bottomLeft) includes: attachmentEdge) ifTrue:
+ 			[morphToMove right: itsCostume left].
+ 		(#(topRight right bottomRight) includes: attachmentEdge) ifTrue:
+ 			[morphToMove left: itsCostume right].
+ 
+ 		morphToMove position: (morphToMove position + offset)]!

Item was added:
+ ----- Method: FollowingWatcher>>unlabeledForPlayer:getter: (in category 'initialization') -----
+ unlabeledForPlayer: aPlayer getter: aGetter 
+ 	"build a simple watcher"
+ 
+ 	| readout |
+ 	self buildForPlayer: aPlayer getter: aGetter.
+ 	readout := self submorphs last.
+ 	(readout isKindOf: TileMorph)
+ 		ifTrue: [readout labelMorph lock: true.
+ 			readout labelMorph font: ScriptingSystem fontForAttachedWatchers.
+ 			readout labelMorph beSticky]!

Item was added:
+ Notification subclass: #FontSubstitutionDuringLoading
+ 	instanceVariableNames: 'familyName pixelSize'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Support'!
+ 
+ !FontSubstitutionDuringLoading commentStamp: '<historical>' prior: 0!
+ signaled by font loading code when reading a DiskProxy that calls for a missing font.!

Item was added:
+ ----- Method: FontSubstitutionDuringLoading class>>forFamilyName:pixelSize: (in category 'instance creation') -----
+ forFamilyName: aName pixelSize: aSize
+ 	^(self new)
+ 		familyName: aName;
+ 		pixelSize: aSize;
+ 		yourself.!

Item was added:
+ ----- Method: FontSubstitutionDuringLoading>>defaultAction (in category 'accessing') -----
+ defaultAction
+ 	familyName ifNil: [ familyName := 'NoName' ].
+ 	pixelSize ifNil: [ pixelSize := 12 ].
+ 
+ 	^((familyName beginsWith: 'Comic')
+ 		ifTrue: [ TextStyle named: (Preferences standardEToysFont familyName) ]
+ 		ifFalse: [ TextStyle default ]) fontOfSize: pixelSize.!

Item was added:
+ ----- Method: FontSubstitutionDuringLoading>>familyName (in category 'accessing') -----
+ familyName
+ 	"Answer the value of familyName"
+ 
+ 	^ familyName!

Item was added:
+ ----- Method: FontSubstitutionDuringLoading>>familyName: (in category 'accessing') -----
+ familyName: anObject
+ 	"Set the value of familyName"
+ 
+ 	familyName _ anObject!

Item was added:
+ ----- Method: FontSubstitutionDuringLoading>>pixelSize (in category 'accessing') -----
+ pixelSize
+ 	"Answer the value of pixelSize"
+ 
+ 	^ pixelSize!

Item was added:
+ ----- Method: FontSubstitutionDuringLoading>>pixelSize: (in category 'accessing') -----
+ pixelSize: anObject
+ 	"Set the value of pixelSize"
+ 
+ 	pixelSize _ anObject!

Item was added:
+ ----- Method: FontSubstitutionDuringLoading>>printOn: (in category 'accessing') -----
+ printOn: aStream
+ 	super printOn: aStream.
+ 	aStream nextPut: $(;
+ 		nextPutAll: familyName;
+ 		nextPut: $-;
+ 		print: pixelSize;
+ 		nextPut: $).!

Item was added:
+ ----- Method: Form>>asStringFormOn: (in category '*Etoys-Squeakland-fileIn/Out') -----
+ asStringFormOn: aStream
+ 	"XXX unfinished, see CursorWithAlpha class>>olpcNormal"
+ 	| used characters bitsStream |
+ 	used := bits asSet.
+ 	used size > 36 ifTrue: [self error: 'too many colors'].
+ 	characters := Dictionary new.
+ 	used := used asSortedCollection.
+ 	used withIndexDo: [:value :index |
+ 		characters at: value put: (Character digitValue: index).
+ 		aStream nextPutAll: '16r'.
+ 		value printOn: aStream base: 16.
+ 		aStream space].
+ 	bitsStream := bits readStream.
+ 	1 to: height do: [:y |
+ 		1 to: width do: [:x | aStream nextPut: (characters at: bitsStream next)].
+ 		aStream crtab: 2].
+ 	^ aStream!

Item was added:
+ ----- Method: Form>>blendColor: (in category '*Etoys-Squeakland-converting') -----
+ blendColor: aTranslucentColor 
+ 	"((ScriptingSystem formAtKey: #TryIt) blendColor: (Color black alpha:
+ 	0.5)) displayAt: 0 @ 0"
+ 	"((ScriptingSystem formAtKey: #TryIt) blendColor: (Color red alpha: 0.5))
+ 	displayAt: 0 @ 0"
+ 	| form canvas |
+ 	form := self deepCopy asFormOfDepth: 32.
+ 	canvas := form getCanvas.
+ 	canvas
+ 		stencil: form
+ 		at: 0 @ 0
+ 		sourceRect: (0 @ 0 extent: form extent)
+ 		color: aTranslucentColor.
+ 	^ canvas form!

Item was added:
+ ----- Method: Form>>scaledToHeight: (in category '*Etoys-Squeakland-scaling, rotation') -----
+ scaledToHeight: newHeight
+ 	"Answer the receiver, scaled such that it has the desired height."
+ 
+ 	newHeight = self height ifTrue: [^ self].
+ 	^self magnify: self boundingBox by: (newHeight / self height) smoothing: 2.
+ !

Item was added:
+ ----- Method: FormEditorView>>cacheBitsAsTwoTone (in category '*Etoys-Squeakland-as yet unclassified') -----
+ cacheBitsAsTwoTone
+ 	^ false!

Item was added:
+ Object subclass: #FormInput
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Forms'!
+ 
+ !FormInput commentStamp: '<historical>' prior: 0!
+ an input instance for a form.  A form takes its input from a collection of FormInputs; each FormInput has a name and can retrieve a textual value.  WHen a form is submitted, these name-value associations are gathered together and passed to an HTTP server.!

Item was added:
+ ----- Method: FormInput>>active (in category 'input handling') -----
+ active
+ 	"whether this input is currently providing an input"
+ 	^self name isNil not!

Item was added:
+ ----- Method: FormInput>>isRadioButtonSetInput (in category 'testing') -----
+ isRadioButtonSetInput
+ 	^false!

Item was added:
+ ----- Method: FormInput>>name (in category 'input handling') -----
+ name
+ 	"name associated with this input"
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: FormInput>>reset (in category 'input handling') -----
+ reset
+ 	"reset to a default value"
+ 	!

Item was added:
+ ----- Method: FormInput>>value (in category 'input handling') -----
+ value
+ 	"value associated with this input"
+ 	^self subclassResponsibility!

Item was added:
+ Model subclass: #FormInputSet
+ 	instanceVariableNames: 'inputs browser form'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Forms'!
+ 
+ !FormInputSet commentStamp: '<historical>' prior: 0!
+ Holds the inputs for an instance of an HTML Form.  It has a link to the browser it will be displayed in, and it has a link to each of the input PluggableTextMorph's that it input will read from.
+ 
+ inputs - maps HtmlInput's into the text morphs which will input their value.!

Item was added:
+ ----- Method: FormInputSet class>>forForm:andBrowser: (in category 'instance creation') -----
+ forForm: form  andBrowser: browser
+ 	"create a FormData for the given form and browser"
+ 	^super new form: form  browser: browser!

Item was added:
+ ----- Method: FormInputSet>>addInput: (in category 'adding inputs') -----
+ addInput: anInput
+ 	inputs add: anInput!

Item was added:
+ ----- Method: FormInputSet>>form:browser: (in category 'private-initialization') -----
+ form: f  browser: b
+ 	inputs _ OrderedCollection new.
+ 	form _ f.
+ 	browser _ b.!

Item was added:
+ ----- Method: FormInputSet>>inputs (in category 'adding inputs') -----
+ inputs
+ 	"return a list of the list of inputs"
+ 	^inputs!

Item was added:
+ ----- Method: FormInputSet>>reset (in category 'action') -----
+ reset
+ 	"reset all inputs to their default value"
+ 	inputs do: [ :input | input reset ]!

Item was added:
+ ----- Method: FormInputSet>>submit (in category 'action') -----
+ submit
+ 	"collect inputs and instruct the browser to do a submission"
+ 	| inputValues |
+ 	inputValues _ Dictionary new.
+ 
+ 	inputs do: [ :input |
+ 		input active ifTrue: [
+ 			(inputValues includesKey: input name) ifFalse: [
+ 				inputValues at: input name  put: (OrderedCollection new: 1) ].
+ 			(inputValues at: input name)  add: input value ] ].
+ 	browser submitFormWithInputs: inputValues url: form url
+ 		method: form method encoding: form encoding.
+ 	^true!

Item was added:
+ AlignmentMorph subclass: #FreeCell
+ 	instanceVariableNames: 'board cardsRemainingDisplay elapsedTimeDisplay gameNumberDisplay lastGameLost state autoMoveRecursionCount myFillStyle'
+ 	classVariableNames: 'Statistics'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!

Item was added:
+ ----- Method: FreeCell class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName:	'FreeCell' translatedNoop
+ 		categories:		{'Games' translatedNoop}
+ 		documentation:	'A unique solitaire card game' translatedNoop!

Item was added:
+ ----- Method: FreeCell class>>initialize (in category 'class initialization') -----
+ initialize
+ 
+ 	Statistics _ FreeCellStatistics new.!

Item was added:
+ ----- Method: FreeCell>>autoMovingHome (in category 'actions') -----
+ autoMovingHome
+ 
+ 	elapsedTimeDisplay pause.
+ 	autoMoveRecursionCount _ autoMoveRecursionCount + 1.!

Item was added:
+ ----- Method: FreeCell>>board (in category 'accessing') -----
+ board
+ 
+ 	board ifNil: 
+ 		[board _ FreeCellBoard new
+ 			target: self;
+ 			actionSelector: #boardAction:].
+ 	^board!

Item was added:
+ ----- Method: FreeCell>>boardAction: (in category 'actions') -----
+ boardAction: actionSymbol
+ 
+ 	actionSymbol = #cardMovedHome 	ifTrue: [^self cardMovedHome].
+ 	actionSymbol = #autoMovingHome	ifTrue: [^self autoMovingHome].!

Item was added:
+ ----- Method: FreeCell>>buildButton:target:label:selector: (in category 'private') -----
+ buildButton: aButton target: aTarget label: aLabel selector: aSelector
+ 	"wrap a button or switch in an alignmentMorph to provide some space around the button"
+ 
+ 	| a |
+ 	aButton 
+ 		target: aTarget;
+ 		label: aLabel;
+ 		actionSelector: aSelector;
+ 		borderColor: #raised;
+ 		borderWidth: 2;
+ 		color: Color gray.
+ 	a _ AlignmentMorph newColumn
+ 		wrapCentering: #center; cellPositioning: #topCenter;
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #shrinkWrap;
+ 		color: Color transparent;
+ 		layoutInset: 1.
+ 	a addMorph: aButton.
+ 	^ a
+ 
+ !

Item was added:
+ ----- Method: FreeCell>>cardMovedHome (in category 'actions') -----
+ cardMovedHome
+ 
+ 	cardsRemainingDisplay value: (cardsRemainingDisplay value - 1).
+ 	autoMoveRecursionCount _ autoMoveRecursionCount - 1 max: 0.
+ 	cardsRemainingDisplay value = 0 
+ 		ifTrue: [self gameWon]
+ 		ifFalse: [autoMoveRecursionCount = 0 ifTrue: [elapsedTimeDisplay continue]].!

Item was added:
+ ----- Method: FreeCell>>colorNearBottom (in category 'visual properties') -----
+ colorNearBottom
+ 
+ 	^Color r: 0.0 g: 0.455 b: 0.18!

Item was added:
+ ----- Method: FreeCell>>colorNearTop (in category 'visual properties') -----
+ colorNearTop
+ 
+ 	^ (Color r: 0.304 g: 0.833 b: 0.075)!

Item was added:
+ ----- Method: FreeCell>>currentGame (in category 'accessing') -----
+ currentGame
+ 
+ 	^self board cardDeck seed!

Item was added:
+ ----- Method: FreeCell>>defaultBackgroundColor (in category 'user interface') -----
+ defaultBackgroundColor
+ 
+ 	^Color r: 0.365 g: 1.0 b: 0.09!

Item was added:
+ ----- Method: FreeCell>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ 	"answer the default border width for the receiver"
+ 	^ 2!

Item was added:
+ ----- Method: FreeCell>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ self colorNearTop!

Item was added:
+ ----- Method: FreeCell>>fillStyle (in category 'visual properties') -----
+ fillStyle
+ 
+ 	myFillStyle ifNil: [
+ 		myFillStyle _ GradientFillStyle ramp: {
+ 			0.0 -> self colorNearTop. 
+ 			1.0 -> self colorNearBottom
+ 		}.
+ 	].
+ 	^myFillStyle
+ 		origin: self position;
+ 		direction: (self width // 2)@self height
+ !

Item was added:
+ ----- Method: FreeCell>>gameLost (in category 'actions') -----
+ gameLost
+ 
+ 	state _ #lost.
+ 	elapsedTimeDisplay stop.
+ 	cardsRemainingDisplay highlighted: true; flash: true.
+ 	Statistics gameLost: self currentGame!

Item was added:
+ ----- Method: FreeCell>>gameWon (in category 'actions') -----
+ gameWon
+ 
+ 	state _ #won.
+ 	elapsedTimeDisplay stop; highlighted: true; flash: true.
+ 	Statistics gameWon: self currentGame!

Item was added:
+ ----- Method: FreeCell>>help (in category 'actions') -----
+ help
+ 	| window helpMorph |
+ 	window := SystemWindow labelled: 'FreeCell Help' translated.
+ 	window model: self.
+ 	helpMorph := (PluggableTextMorph new editString: self helpText) lock.
+ 	window
+ 		addMorph: helpMorph
+ 		frame: (0 @ 0 extent: 1 @ 1).
+ 	window openInWorld!

Item was added:
+ ----- Method: FreeCell>>helpText (in category 'accessing') -----
+ helpText
+ 	^ 'The objective of FreeCell is to move all of the cards to the four "home cells" in the upper right corner.  Each home cell will hold one suit and must be filled sequentially starting with the Ace.
+ 
+ There are four "free cells" in the upper left corner that can each hold one card.  Cards can be moved from the bottom of a stack to a free cell or to another stack.  
+ 
+ When moving a card to another stack, it must have a value that is one less than the exposed card and of a different color.' translated!

Item was added:
+ ----- Method: FreeCell>>inAutoMove (in category 'actions') -----
+ inAutoMove
+ 	"Return true if an automove sequence is in progress"
+ 
+ 	^ autoMoveRecursionCount > 0!

Item was added:
+ ----- Method: FreeCell>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	Statistics newSession.
+ 	autoMoveRecursionCount _ 0.
+ 	self listDirection: #topToBottom.
+ 	self wrapCentering: #center;
+ 		 cellPositioning: #topCenter.
+ 	self vResizing: #shrinkWrap.
+ 	self hResizing: #shrinkWrap.
+ 	self
+ 		 addMorph: self makeControls;
+ 		 addMorph: self board;
+ 		 newGame!

Item was added:
+ ----- Method: FreeCell>>makeCardsRemainingDisplay (in category 'initialization') -----
+ makeCardsRemainingDisplay
+ 	cardsRemainingDisplay := LedMorph new digits: 2;
+ 				 extent: 2 * 10 @ 15.
+ 	^ self wrapPanel: cardsRemainingDisplay label: 'Cards Left: ' translated!

Item was added:
+ ----- Method: FreeCell>>makeControlBar (in category 'initialization') -----
+ makeControlBar
+ 
+ 	^AlignmentMorph newRow
+ 		color: self colorNearBottom;
+ 		borderColor: #inset;
+ 		borderWidth: 2;
+ 		layoutInset: 0;
+ 		hResizing: #spaceFill; vResizing: #shrinkWrap; wrapCentering: #center; cellPositioning: #leftCenter;
+ 		yourself.!

Item was added:
+ ----- Method: FreeCell>>makeControls (in category 'initialization') -----
+ makeControls
+ 
+ 	^self makeControlBar
+ 		addMorph: AlignmentMorph newVariableTransparentSpacer;
+ 		addMorph: self makeHelpButton;
+ 		addMorph: self makeQuitButton;
+ 		addMorph: self makeStatisticsButton;
+ 		addMorph: self makeGameNumberDisplay;
+ 		addMorph: self makePickGameButton;
+ 		addMorph: self makeSameGameButton;
+ 		addMorph: self makeNewGameButton;
+ 		addMorph: self makeElapsedTimeDisplay;
+ 		addMorph: self makeCardsRemainingDisplay;
+ 		yourself.!

Item was added:
+ ----- Method: FreeCell>>makeElapsedTimeDisplay (in category 'initialization') -----
+ makeElapsedTimeDisplay
+ 	elapsedTimeDisplay := LedTimerMorph new digits: 3;
+ 				 extent: 3 * 10 @ 15.
+ 	^ self wrapPanel: elapsedTimeDisplay label: 'Elapsed Time: ' translated!

Item was added:
+ ----- Method: FreeCell>>makeGameNumberDisplay (in category 'initialization') -----
+ makeGameNumberDisplay
+ 	gameNumberDisplay := LedMorph new digits: 5;
+ 				 extent: 5 * 10 @ 15.
+ 	^ self wrapPanel: gameNumberDisplay label: 'Game #: ' translated!

Item was added:
+ ----- Method: FreeCell>>makeHelpButton (in category 'initialization') -----
+ makeHelpButton
+ 	^ self
+ 		buildButton: SimpleButtonMorph new
+ 		target: self
+ 		label: 'Help' translated
+ 		selector: #help!

Item was added:
+ ----- Method: FreeCell>>makeNewGameButton (in category 'initialization') -----
+ makeNewGameButton
+ 	^ self
+ 		buildButton: SimpleButtonMorph new
+ 		target: self
+ 		label: 'New game' translated
+ 		selector: #newGame!

Item was added:
+ ----- Method: FreeCell>>makePickGameButton (in category 'initialization') -----
+ makePickGameButton
+ 	^ self
+ 		buildButton: SimpleButtonMorph new
+ 		target: self
+ 		label: 'Pick game' translated
+ 		selector: #pickGame!

Item was added:
+ ----- Method: FreeCell>>makeQuitButton (in category 'initialization') -----
+ makeQuitButton
+ 	^ self
+ 		buildButton: SimpleButtonMorph new
+ 		target: self
+ 		label: 'Quit' translated
+ 		selector: #quit!

Item was added:
+ ----- Method: FreeCell>>makeSameGameButton (in category 'initialization') -----
+ makeSameGameButton
+ 	^ self
+ 		buildButton: SimpleButtonMorph new
+ 		target: self
+ 		label: 'Same game' translated
+ 		selector: #sameGame!

Item was added:
+ ----- Method: FreeCell>>makeStatisticsButton (in category 'initialization') -----
+ makeStatisticsButton
+ 	^ self
+ 		buildButton: SimpleButtonMorph new
+ 		target: self
+ 		label: 'Statistics' translated
+ 		selector: #statistics!

Item was added:
+ ----- Method: FreeCell>>modelSleep (in category 'user interface') -----
+ modelSleep
+ 	"When fixing #contains: calls beware of reinventing #includes:"
+ 	(#(newGame sameGame pickGame won lost ) includes: state)
+ 		ifTrue: [elapsedTimeDisplay pause]!

Item was added:
+ ----- Method: FreeCell>>modelWakeUp (in category 'user interface') -----
+ modelWakeUp
+ 	"Maybe less performant but more readable"
+ 	(#(won lost) includes: state)
+ 		ifFalse: [elapsedTimeDisplay resume]!

Item was added:
+ ----- Method: FreeCell>>newGame (in category 'actions') -----
+ newGame
+ 	Collection initialize.
+ 	self newGameNumber: nil.
+ 	state _ #newGame!

Item was added:
+ ----- Method: FreeCell>>newGameNumber: (in category 'actions') -----
+ newGameNumber: aSeedOrNil 
+ 	cardsRemainingDisplay value ~~ 0 ifTrue: [self gameLost].
+ 	cardsRemainingDisplay flash: false; highlighted: false; value: 52.
+ 	elapsedTimeDisplay flash: false; highlighted: false.
+ 	"board handles nil case"
+ 	self board pickGame: aSeedOrNil.
+ 	elapsedTimeDisplay reset; start.
+ 	gameNumberDisplay value: self currentGame!

Item was added:
+ ----- Method: FreeCell>>openInWindowLabeled:inWorld: (in category 'initialization') -----
+ openInWindowLabeled: aString inWorld: aWorld
+ 
+ 	^(super openInWindowLabeled: aString inWorld: aWorld)
+ 		model: self;
+ 		yourself!

Item was added:
+ ----- Method: FreeCell>>pickGame (in category 'actions') -----
+ pickGame
+ 	| seed |
+ 	seed _ self promptForSeed.
+ 	seed isNil ifTrue: [^ self].
+ 	self newGameNumber: seed.
+ 	state _ #pickGame!

Item was added:
+ ----- Method: FreeCell>>promptForSeed (in category 'actions') -----
+ promptForSeed
+ 	| ss ii hh |
+ 	[hh := board hardness
+ 				ifNil: [0].
+ 	ss := FillInTheBlank request: 'Pick a game number between 1 and 32000.
+ or
+ set the hardness of the next game by typing ''H 30''.
+ Above 100 is very hard.  Zero is standard game.
+ Current hardness is: ' translated , hh printString.
+ 	"Let the user cancel."
+ 	ss isEmpty
+ 		ifTrue: [^ nil].
+ 	ss := ss withoutQuoting.
+ 	ss first asLowercase == $h
+ 		ifTrue: ["Set the hardness"
+ 			[ii := ss numericSuffix]
+ 				on: Error
+ 				do: [ii := 0].
+ 			board hardness: ii.
+ 			^ nil].
+ 	[ii := ss asNumber asInteger]
+ 		on: Error
+ 		do: [ii := 0].
+ 	ii between: 1 and: 32000] whileFalse.
+ 	^ ii!

Item was added:
+ ----- Method: FreeCell>>quit (in category 'actions') -----
+ quit
+ 	cardsRemainingDisplay value ~~ 0 ifTrue: [self gameLost].
+ 
+ 	self owner == self world
+ 		ifTrue: [self delete]
+ 		ifFalse: [self owner delete].
+ 	Statistics close!

Item was added:
+ ----- Method: FreeCell>>sameGame (in category 'actions') -----
+ sameGame
+ 	self newGameNumber: self currentGame.
+ 	state _ #sameGame.
+ 
+ !

Item was added:
+ ----- Method: FreeCell>>statistics (in category 'actions') -----
+ statistics
+ 
+ 	Statistics display!

Item was added:
+ ----- Method: FreeCell>>wrapPanel:label: (in category 'private') -----
+ wrapPanel: anLedPanel label: aLabel
+ 	"wrap an LED panel in an alignmentMorph with a label to its left"
+ 
+ 	| a |
+ 	a _ AlignmentMorph newRow
+ 		wrapCentering: #center; cellPositioning: #leftCenter;
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #shrinkWrap;
+ 		borderWidth: 0;
+ 		layoutInset: 5;
+ 		color: Color transparent.
+ 	a addMorph: anLedPanel.
+ 	a addMorph: (StringMorph contents: aLabel). 
+ 	^ a
+ !

Item was added:
+ AlignmentMorph subclass: #FreeCellBoard
+ 	instanceVariableNames: 'cardDeck lastCardDeck freeCells homeCells stacks target actionSelector hardness'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!
+ 
+ !FreeCellBoard commentStamp: '<historical>' prior: 0!
+ The model of a freecell game.  Holds the stacks of cards.
+ cardDeck		
+ lastCardDeck		
+ freeCells		
+ homeCells		
+ stacks		array of CardDecks of the columns of cards.
+ ----
+ Hardness: a number from 1 to 10000.  
+ 	After dealing, count down the number.  For each count, go to next column, pick a ramdom card (with same generator as deck) and move it one place in its stack.  This is a kind of bubble sort.  Interesting that the slowness of bubble sort is a plus -- gives fine gradation in the hardness.
+ 	Moving a card:  Move red cards to deep half, black to shallow (or vice versa).  Within a color, put low cards deep and high cards shallow.  
+ 	If speed is an issue, move several steps at once, decrementing counter. 
+ 	
+ 	(May make it easier?  If running columns, need a way to make harder in other ways.)!

Item was added:
+ ----- Method: FreeCellBoard class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 
+ 	^false!

Item was added:
+ ----- Method: FreeCellBoard>>acceptCard:onStack: (in category 'actions') -----
+ acceptCard: aCard onStack: aDeck
+ 	" assumes that number of cards was check at drag time, need to reduce count if dropping
+ 	into an empty stack"
+ 	aCard hasSubmorphs 
+ 		ifTrue: [
+ 			aDeck ifEmpty: [
+ 				(aCard submorphCount+1) > (self maxDraggableStackSize: true)
+ 					ifTrue: [^false]]]
+ 		ifFalse: [^ nil].
+ 	^nil.
+ 
+ !

Item was added:
+ ----- Method: FreeCellBoard>>acceptSingleCard:on: (in category 'actions') -----
+ acceptSingleCard: aCard on: aDeck 
+ 	"Home cells and free cells don't accept multiple cards on a home cell, 
+ 	defer to deck for other cases"
+ 	aCard hasSubmorphs
+ 		ifTrue: [^ false]
+ 		ifFalse: [^ nil]!

Item was added:
+ ----- Method: FreeCellBoard>>actionSelector: (in category 'accessing') -----
+ actionSelector: aSymbolOrString
+ 
+ 	(nil = aSymbolOrString or:
+ 	 ['nil' = aSymbolOrString or:
+ 	 [aSymbolOrString isEmpty]])
+ 		ifTrue: [^ actionSelector _ nil].
+ 
+ 	actionSelector _ aSymbolOrString asSymbol.
+ !

Item was added:
+ ----- Method: FreeCellBoard>>addHardness (in category 'hardness') -----
+ addHardness
+ 	| cnt rand pileInd pile |
+ 	"post process the layout of cards to make it harder.  See class comment."
+ 
+ 	hardness ifNil: [^ self].
+ 	cnt _ hardness.
+ 	rand _ Random new seed: cardDeck seed.  "Same numbers but different purpose"
+ 	pileInd _ 1. 
+ 	[(cnt _ cnt - 1) > 0] whileTrue: [
+ 		pile _ stacks atWrap: (pileInd _ pileInd + 1).
+ 		cnt _ cnt - (self makeHarder: pile rand: rand toDo: cnt)].  "mostly 0, but moves cards"!

Item was added:
+ ----- Method: FreeCellBoard>>autoMoveCardsHome (in category 'private') -----
+ autoMoveCardsHome
+ 	| first |
+ 
+ 	first _ false.
+ 	(self stacks, self freeCells) do: [:deck |
+ 		self homeCells do: [ :homeCell |
+ 			deck hasCards ifTrue: [
+ 				(homeCell repelCard: deck topCard) ifFalse: [
+ 					(self isPlayableCardInHomeCells: deck topCard) ifTrue: [
+ 						first ifFalse: [ " trigger autoMoving event on first move."
+ 							first _ true.
+ 							self performActionSelector: #autoMovingHome
+ 						].
+ 						self visiblyMove: deck topCard to: homeCell.
+ 					]
+ 				]
+ 			]
+ 		]
+ 	].
+ 
+ !

Item was added:
+ ----- Method: FreeCellBoard>>captureStateBeforeGrab (in category 'undo') -----
+ captureStateBeforeGrab
+ 
+ 	self removeProperty: #stateBeforeGrab.
+ 	self setProperty: #stateBeforeGrab toValue: self capturedState
+ !

Item was added:
+ ----- Method: FreeCellBoard>>capturedState (in category 'undo') -----
+ capturedState
+ 
+ 	self valueOfProperty: #stateBeforeGrab ifPresentDo: [:st | ^ st].
+ 	^ {	freeCells collect: [:deck | deck submorphs].
+ 		homeCells collect: [:deck | deck submorphs].
+ 		stacks collect: [:deck | deck submorphs] }
+ !

Item was added:
+ ----- Method: FreeCellBoard>>cardCell (in category 'layout') -----
+ cardCell
+ 
+ 	^PlayingCardDeck new
+ 		layout: #pile; 
+ 		listDirection: #topToBottom;
+ 		enableDragNDrop;
+ 		color: Color transparent;
+ 		borderColor: (Color gray alpha: 0.5);
+ 		borderWidth: 2;
+ 		layoutBounds: (0 at 0 extent: PlayingCardMorph width @ PlayingCardMorph height);
+ 		yourself!

Item was added:
+ ----- Method: FreeCellBoard>>cardDeck (in category 'accessing') -----
+ cardDeck
+ 	^cardDeck!

Item was added:
+ ----- Method: FreeCellBoard>>cardMoved (in category 'actions') -----
+ cardMoved
+ 	"Free cells and stacks do nothing special here - yet - th 12/15/1999 
+ 	16:15 "
+ 	self autoMoveCardsHome!

Item was added:
+ ----- Method: FreeCellBoard>>cardMovedHome (in category 'actions') -----
+ cardMovedHome
+ 
+ 	self autoMoveCardsHome.
+ 	self performActionSelector: #cardMovedHome.!

Item was added:
+ ----- Method: FreeCellBoard>>cellsRow (in category 'layout') -----
+ cellsRow
+ 	| row |
+ 
+ 	row := (AlignmentMorph newRow)
+ 		vResizing: #shrinkWrap;
+ 		hResizing: #shrinkWrap;
+ 		color: Color transparent;
+ 		addAllMorphs: self freeCells;
+ 		addMorphBack: self cellsRowSpacer;
+ 		addAllMorphs: self homeCells;
+ 		yourself.
+ 	^row!

Item was added:
+ ----- Method: FreeCellBoard>>cellsRowSpacer (in category 'layout') -----
+ cellsRowSpacer
+ 	| column |
+ 
+ 	column := (AlignmentMorph newColumn)
+ 		vResizing: #rigid;
+ 		hResizing: #rigid;
+ 		color: Color transparent;
+ 		extent: PlayingCardMorph cardSize;
+ 		yourself.
+ 	^column!

Item was added:
+ ----- Method: FreeCellBoard>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color green!

Item was added:
+ ----- Method: FreeCellBoard>>doubleClickInStack:OnCard: (in category 'actions') -----
+ doubleClickInStack: aDeck OnCard: aCard
+ 
+ 	"if there is an empty free cell, move the card there. otherwise try for an empty stack"
+ 
+ 	aCard == aDeck topCard ifFalse: [^self].
+ 	freeCells do: [:freeCell |
+ 		freeCell ifEmpty: [
+ 			self visiblyMove: aCard to: freeCell.
+ 			^ aCard
+ 		]
+ 	].
+ 	stacks do: [ :each |
+ 		each ifEmpty: [
+ 			self visiblyMove: aCard to: each.
+ 			^ aCard
+ 		]
+ 	].
+ !

Item was added:
+ ----- Method: FreeCellBoard>>dragCard:fromHome: (in category 'actions') -----
+ dragCard: aCard fromHome: aCardDeck
+ 
+ 	^nil		"don't allow any cards to be dragged from a home cell"!

Item was added:
+ ----- Method: FreeCellBoard>>dragCard:fromStack: (in category 'actions') -----
+ dragCard: aCard fromStack: aCardDeck
+ 	| i cards |
+ 
+ 	cards _ aCardDeck cards.
+ 	i _ cards indexOf: aCard ifAbsent: [^ nil].
+ 	i > (self maxDraggableStackSize: false) ifTrue: [^ nil].
+ 	[i > 1] whileTrue:
+ 		[(aCardDeck inStackingOrder: (cards at: i-1) 
+ 					onTopOf: (cards at: i)) ifFalse: [^ nil].
+ 		i _ i-1].
+ 	^ aCard!

Item was added:
+ ----- Method: FreeCellBoard>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 
+ 	"we don't have anything to draw, but we need a color so the inset border of one of our submorphs will work"
+ !

Item was added:
+ ----- Method: FreeCellBoard>>freeCell (in category 'layout') -----
+ freeCell
+ 	| freeCell |
+ 	freeCell _ self cardCell.
+ 	freeCell stackingPolicy: #single;
+ 	 emptyDropPolicy: #any;
+ 	 target: self;
+ 	 cardDroppedSelector: #cardMoved;
+ 	 acceptCardSelector: #acceptSingleCard:on:.
+ 	^ freeCell!

Item was added:
+ ----- Method: FreeCellBoard>>freeCells (in category 'layout') -----
+ freeCells
+ 
+ 	^freeCells ifNil: [freeCells := (1 to: 4) collect: [:i | self freeCell]]!

Item was added:
+ ----- Method: FreeCellBoard>>hardness (in category 'accessing') -----
+ hardness
+ 	^ hardness!

Item was added:
+ ----- Method: FreeCellBoard>>hardness: (in category 'accessing') -----
+ hardness: integer
+ 	hardness _ integer	"or nil"!

Item was added:
+ ----- Method: FreeCellBoard>>homeCell (in category 'layout') -----
+ homeCell
+ 	| homeCell |
+ 	homeCell _ self cardCell.
+ 	homeCell stackingPolicy: #straight;
+ 	 stackingOrder: #ascending;
+ 	 emptyDropPolicy: #inOrder;
+ 	 target: self;
+ 	 cardDroppedSelector: #cardMovedHome;
+ 	 cardDraggedSelector: #dragCard:fromHome:;
+ 	 acceptCardSelector: #acceptSingleCard:on:.
+ 	^ homeCell!

Item was added:
+ ----- Method: FreeCellBoard>>homeCells (in category 'layout') -----
+ homeCells
+ 
+ 	^homeCells ifNil: [homeCells := (1 to: 4) collect: [:i | self homeCell]]!

Item was added:
+ ----- Method: FreeCellBoard>>inAutoMove (in category 'actions') -----
+ inAutoMove
+ 	"Return true if an automove sequence is in progress"
+ 
+ 	^ owner inAutoMove!

Item was added:
+ ----- Method: FreeCellBoard>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	self listDirection: #topToBottom;
+ 	  hResizing: #shrinkWrap;
+ 	  vResizing: #rigid;
+ 	  height: 500;
+ 	  layout!

Item was added:
+ ----- Method: FreeCellBoard>>isPlayableCardInHomeCells: (in category 'private') -----
+ isPlayableCardInHomeCells: aPlayingCard
+ 	| unplayedOther topsThisColor topsOtherColor unplayedSame | 
+ 	" are all cards that could be played on this card if it stayed on the stack present in the
+ 	home cells?"
+ 
+ 	aPlayingCard cardNumber <= 2 ifTrue: [^true].	"special case for Aces and 2's"
+ 	topsThisColor _ OrderedCollection new.
+ 	topsOtherColor _ OrderedCollection new.
+ 	self homeCells do: [ :deck |
+ 		deck hasCards ifTrue: [
+ 			(aPlayingCard suitColor == deck topCard suitColor 
+ 					ifTrue: [topsThisColor] ifFalse: [topsOtherColor]) add: deck topCard cardNumber.
+ 		]
+ 	].
+ 	unplayedOther _ topsOtherColor size < 2 ifTrue: [1] ifFalse: [topsOtherColor min + 1].
+ 	unplayedSame _ topsThisColor size < 2 ifTrue: [1] ifFalse: [topsThisColor min + 1].
+ 	unplayedOther > (aPlayingCard cardNumber - 1) ifTrue: [^true].
+ 	unplayedOther < (aPlayingCard cardNumber - 1) ifTrue: [^false].
+ 	^unplayedSame >= (unplayedOther - 1)
+ !

Item was added:
+ ----- Method: FreeCellBoard>>layout (in category 'layout') -----
+ layout
+ 
+ 	self 
+ 		addMorphBack: self cellsRow;
+ 		addMorphBack: self stacksRow.
+ !

Item was added:
+ ----- Method: FreeCellBoard>>makeHarder:rand:toDo: (in category 'hardness') -----
+ makeHarder: pile rand: rand toDo: cnt
+ 	| deepColor ind thisPile thisCard otherCard |
+ 	"Move cards in a stack to make it harder.  Pick a card from the pile.  Only consider moving it deeper (toward last of pile)."
+ 
+ 	deepColor _ stacks first cards last suitColor.
+ 	ind _ ((pile cards size - 1) atRandom: rand).	"front card"
+ 	thisPile _ pile cards.  "submorphs array. We will stomp it."
+ 	thisCard _ thisPile at: ind.
+ 	otherCard _ thisPile at: ind+1.
+ 
+ 	"Move deepColor cards deeper, past cards of the other color"
+ 	(thisCard suitColor == deepColor) & (otherCard suitColor ~~ deepColor) ifTrue: [
+ 		thisPile at: ind put: otherCard.
+ 		thisPile at: ind+1 put: thisCard.
+ 		^ 0].	"single moves for now.  Make multiple when it's too slow this way"
+ 
+ 	"When colors the same, move low numbered cards deeper, past high cards"
+ 	(thisCard suitColor == otherCard suitColor) ifTrue: [
+ 		(thisCard cardNumber < otherCard cardNumber) ifTrue: [
+ 			thisPile at: ind put: otherCard.
+ 			thisPile at: ind+1 put: thisCard.
+ 			^ 0]].	"single moves for now.  Make multiple when it's too slow this way"
+ 	^ 0!

Item was added:
+ ----- Method: FreeCellBoard>>maxDraggableStackSize: (in category 'private') -----
+ maxDraggableStackSize: dropIntoEmptyStack
+ 	"Note: dropIntoEmptyStack, means one less empty stack to work with.
+ 		This needs to be reevaluated at time of drop."
+ 	"Not super smart - doesn't use stacks that are buildable though not empty"
+ 
+ 	| nFree nEmptyStacks |
+ 	nFree _ (freeCells select: [:d | d hasCards not]) size.
+ 	nEmptyStacks _ (stacks select: [:d | d hasCards not]) size.
+ 	dropIntoEmptyStack ifTrue: [nEmptyStacks _ nEmptyStacks - 1].
+ 	^ (1 + nFree) * (2 raisedTo: nEmptyStacks)!

Item was added:
+ ----- Method: FreeCellBoard>>performActionSelector: (in category 'private') -----
+ performActionSelector: actionSymbol 
+ 	(target notNil and: [actionSelector notNil]) 
+ 		ifTrue: [target perform: actionSelector with: actionSymbol]!

Item was added:
+ ----- Method: FreeCellBoard>>pickGame: (in category 'initialization') -----
+ pickGame: aSeedOrNil 
+ 	| sorted msg |
+ 	cardDeck := PlayingCardDeck newDeck.
+ 	aSeedOrNil == 1
+ 		ifTrue: ["Special case of game 1 does a time profile playing the entire 
+ 			(trivial) game."
+ 			sorted := cardDeck submorphs
+ 						asSortedCollection: [:a :b | a cardNumber >= b cardNumber].
+ 			cardDeck removeAllMorphs; addAllMorphs: sorted.
+ 			self resetBoard.
+ 			self world doOneCycle.
+ 			Utilities
+ 				informUser: 'Game #1 is a special case
+ for performance analysis' translated
+ 				during: [msg := self world firstSubmorph.
+ 					msg align: msg topRight with: owner bottomRight.
+ 					MessageTally
+ 						spyOn: [sorted last owner doubleClickOnCard: sorted last]]]
+ 		ifFalse: [aSeedOrNil
+ 				ifNotNil: [cardDeck seed: aSeedOrNil].
+ 			cardDeck shuffle.
+ 			self resetBoard]!

Item was added:
+ ----- Method: FreeCellBoard>>rememberUndoableAction:named: (in category 'undo') -----
+ rememberUndoableAction: aBlock named: caption
+ 
+ 	self inAutoMove ifTrue: [^ aBlock value].
+ 	^ super rememberUndoableAction: aBlock named: caption!

Item was added:
+ ----- Method: FreeCellBoard>>resetBoard (in category 'initialization') -----
+ resetBoard
+ 
+ 	self purgeAllCommands.
+ 	self resetFreeCells;
+ 		resetHomeCells;
+ 		resetStacks;
+ 		addHardness;
+ 		changed.!

Item was added:
+ ----- Method: FreeCellBoard>>resetFreeCells (in category 'initialization') -----
+ resetFreeCells
+ 
+ 	freeCells do: [:deck | deck removeAllCards]!

Item was added:
+ ----- Method: FreeCellBoard>>resetHomeCells (in category 'initialization') -----
+ resetHomeCells
+ 
+ 	homeCells do: [:deck | deck removeAllCards]!

Item was added:
+ ----- Method: FreeCellBoard>>resetStacks (in category 'initialization') -----
+ resetStacks
+ 	| card stackStream stack |
+ 
+ 	stacks do: [:deck | deck removeAllCards].
+ 	stackStream _ ReadStream on: stacks.
+ 	[card _ cardDeck deal.
+ 	card notNil] whileTrue: [
+ 		stack _ stackStream next ifNil: [stackStream reset; next].
+ 		stack addCard: card].
+ !

Item was added:
+ ----- Method: FreeCellBoard>>stack (in category 'card in a stack') -----
+ stack
+ 	^ PlayingCardDeck new color: Color transparent;
+ 	 layout: #stagger;
+ 	 listDirection: #topToBottom;
+ 	 enableDragNDrop;
+ 	 stackingPolicy: #altStraight;
+ 	 stackingOrder: #descending;
+ 	 emptyDropPolicy: #any;
+ 	 target: self;
+ 	 cardDroppedSelector: #cardMoved;
+ 	 cardDraggedSelector: #dragCard:fromStack:;
+ 	 acceptCardSelector: #acceptCard:onStack:;
+ 	 cardDoubleClickSelector: #doubleClickInStack:OnCard:!

Item was added:
+ ----- Method: FreeCellBoard>>stacks (in category 'layout') -----
+ stacks
+ 
+ 	^stacks ifNil: [stacks:= (1 to: 8) collect: [:i | self stack]]!

Item was added:
+ ----- Method: FreeCellBoard>>stacksRow (in category 'layout') -----
+ stacksRow
+ 	| row |
+ 
+ 	row := (AlignmentMorph newRow)
+ 		vResizing: #spaceFill;
+ 		hResizing: #spaceFill;
+ 		wrapCentering: #topLeft;
+ 		cellPositioning: #topLeft;
+ 		color: Color transparent;
+ 		yourself.
+ 	self stacks do: [:stack |
+ 		row 
+ 			addMorphBack: AlignmentMorph newVariableTransparentSpacer;
+ 			addMorphBack: stack].
+ 	row addMorphBack: AlignmentMorph newVariableTransparentSpacer.
+ 	^row!

Item was added:
+ ----- Method: FreeCellBoard>>target: (in category 'accessing') -----
+ target: anObject
+ 
+ 	target _ anObject!

Item was added:
+ ----- Method: FreeCellBoard>>undoFromCapturedState: (in category 'undo') -----
+ undoFromCapturedState: st
+ 	freeCells with: st first do: [:deck :morphs | deck removeAllMorphs; addAllMorphs: morphs].
+ 	homeCells with: st second do: [:deck :morphs | deck removeAllMorphs; addAllMorphs: morphs].
+ 	stacks with: st third do: [:deck :morphs | deck removeAllMorphs; addAllMorphs: morphs]!

Item was added:
+ ----- Method: FreeCellBoard>>visiblyMove:to: (in category 'private') -----
+ visiblyMove: aCard to: aCell
+ 	| p1 p2 nSteps |
+ 	self inAutoMove ifFalse: [self captureStateBeforeGrab].
+ 	owner owner addMorphFront: aCard.
+ 	p1 _ aCard position.
+ 	p2 _ aCell position.
+ 	nSteps _ 10.
+ 	1 to: nSteps-1 do: "Note final step happens with actual drop"
+ 		[:i | aCard position: ((p2*i) + (p1*(nSteps-i))) // nSteps.
+ 		self world displayWorld].
+ 	aCell acceptDroppingMorph: aCard event: nil!

Item was added:
+ Object subclass: #FreeCellStatistics
+ 	instanceVariableNames: 'sessionWins sessionLosses totalWins totalLosses streakWins streakLosses winsWithReplay lossesWithReplay lastGameWon lastGameLost currentCount currentType window statsMorph'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!

Item was added:
+ ----- Method: FreeCellStatistics class>>includeInNewMorphMenu (in category 'instance creation') -----
+ includeInNewMorphMenu
+ 
+ 	^false!

Item was added:
+ ----- Method: FreeCellStatistics>>buildButton:target:label:selector: (in category 'user interface') -----
+ buildButton: aButton target: aTarget label: aLabel selector: aSelector
+ 	"wrap a button or switch in an alignmentMorph to provide some space around the button"
+ 
+ 	| a |
+ 	aButton 
+ 		target: aTarget;
+ 		label: aLabel;
+ 		actionSelector: aSelector;
+ 		borderColor: #raised;
+ 		borderWidth: 2;
+ 		color: Color gray.
+ 	a _ AlignmentMorph newColumn
+ 		wrapCentering: #center; cellPositioning: #topCenter;
+ 		hResizing: #spaceFill;
+ 		vResizing: #shrinkWrap;
+ 		color: Color transparent;
+ 		layoutInset: 1.
+ 	a addMorph: aButton.
+ 	^ a
+ 
+ !

Item was added:
+ ----- Method: FreeCellStatistics>>changed (in category 'updating') -----
+ changed
+ 
+ 	window ifNotNil: [
+ 		statsMorph ifNotNil: [statsMorph contents: self statsText]]!

Item was added:
+ ----- Method: FreeCellStatistics>>close (in category 'user interface') -----
+ close
+ 
+ 	window ifNotNil: [
+ 		window delete.
+ 		window _ nil].!

Item was added:
+ ----- Method: FreeCellStatistics>>color (in category 'user interface') -----
+ color
+ 
+ 	^Color green darker!

Item was added:
+ ----- Method: FreeCellStatistics>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color green!

Item was added:
+ ----- Method: FreeCellStatistics>>display (in category 'user interface') -----
+ display
+ 	| panel |
+ 
+ 	(window notNil and: [window owner notNil]) ifTrue: [window activate. ^nil].
+ 	panel _ AlignmentMorph newColumn.
+ 	panel
+ 		wrapCentering: #center; cellPositioning: #topCenter;
+ 		hResizing: #rigid;
+ 		vResizing: #rigid;
+ 		extent: 250 at 150;
+ 		color: self color;
+ 		addMorphBack: self makeStatistics;
+ 		addMorphBack: self makeControls.
+ 	window _ panel openInWindowLabeled: 'FreeCell Statistics' translated.!

Item was added:
+ ----- Method: FreeCellStatistics>>gameLost: (in category 'actions') -----
+ gameLost: gameNumber
+ 
+ 	"Don't count multiple losses of the same game"
+ 	gameNumber = lastGameLost ifTrue: [^ self].
+ 	lastGameLost _ gameNumber.
+ 
+ 	sessionLosses _ sessionLosses + 1.
+ 	totalLosses _ totalLosses + 1.
+ 	lossesWithReplay _ lossesWithReplay + 1.
+ 	currentType = #losses
+ 		ifTrue: [currentCount _ currentCount + 1]
+ 		ifFalse: 
+ 			[currentCount _ 1.
+ 			currentType _ #losses].
+ 	self updateStreak.
+ 	self changed!

Item was added:
+ ----- Method: FreeCellStatistics>>gameWon: (in category 'actions') -----
+ gameWon: gameNumber
+ 	sessionWins _ sessionWins + 1.
+ 	totalWins _ totalWins + 1.
+ 	gameNumber = lastGameWon ifFalse:
+ 		[gameNumber = lastGameLost ifTrue:
+ 			["Finally won a game by replaying"
+ 			lossesWithReplay _ lossesWithReplay - 1].
+ 		winsWithReplay _ winsWithReplay + 1].
+ 	lastGameWon _ gameNumber.
+ 	currentType = #wins
+ 		ifTrue: [currentCount _ currentCount + 1]
+ 		ifFalse: [currentCount _ 1.
+ 				currentType _ #wins].
+ 	self updateStreak.
+ 	self changed!

Item was added:
+ ----- Method: FreeCellStatistics>>initialize (in category 'initialization') -----
+ initialize
+ 	super initialize.
+ 	self reset!

Item was added:
+ ----- Method: FreeCellStatistics>>makeControls (in category 'user interface') -----
+ makeControls
+ 	| row |
+ 
+ 	row _ AlignmentMorph newRow.
+ 	row
+ 		wrapCentering: #center; cellPositioning: #leftCenter;
+ 		hResizing: #spaceFill;
+ 		vResizing: #shrinkWrap;
+ 		color: self color;
+ 		borderWidth: 2;
+ 		borderColor: #inset;
+ 		addMorphBack: self makeOkButton;
+ 		addMorphBack: self makeResetButton.
+ 	^row.!

Item was added:
+ ----- Method: FreeCellStatistics>>makeOkButton (in category 'user interface') -----
+ makeOkButton
+ 
+ 	^self
+ 		buildButton: SimpleButtonMorph new
+ 		target: self
+ 		label: 'OK' translated
+ 		selector: #ok!

Item was added:
+ ----- Method: FreeCellStatistics>>makeResetButton (in category 'user interface') -----
+ makeResetButton
+ 
+ 	^self
+ 		buildButton: SimpleButtonMorph new
+ 		target: self
+ 		label: 'Reset' translated
+ 		selector: #reset!

Item was added:
+ ----- Method: FreeCellStatistics>>makeStatistics (in category 'user interface') -----
+ makeStatistics
+ 	| row |
+ 
+ 	row _ AlignmentMorph newRow.
+ 	row
+ 		wrapCentering: #center; cellPositioning: #leftCenter;
+ 		hResizing: #spaceFill;
+ 		vResizing: #spaceFill;
+ 		color: self color;
+ 		borderWidth: 2;
+ 		borderColor: #inset;
+ 		addMorphBack: (AlignmentMorph newColumn
+ 			wrapCentering: #center; cellPositioning: #topCenter;
+ 			color: self color;
+ 			addMorph: (statsMorph _ TextMorph new contents: self statsText)).
+ 	^row.!

Item was added:
+ ----- Method: FreeCellStatistics>>newSession (in category 'actions') -----
+ newSession
+ 
+ 	sessionWins _ 0.
+ 	sessionLosses _ 0.
+ 	currentCount _ 0.
+ 	currentType _ nil.
+ 	self changed.!

Item was added:
+ ----- Method: FreeCellStatistics>>ok (in category 'actions') -----
+ ok
+ 
+ 	window delete.
+ 	window _ nil.!

Item was added:
+ ----- Method: FreeCellStatistics>>print:type:on: (in category 'printing') -----
+ print: aNumber type: type on: aStream 
+ 	"I moved the code from #printWins:on: and #printLosses:on: here because 
+ 	it is basically 
+ 	the same. I hope this increases the maintainability. - th 12/20/1999 20:37"
+ 	aStream print: aNumber.
+ 	type = #wins
+ 		ifTrue: [aNumber = 1
+ 				ifTrue: [aStream nextPutAll: ' win' translated]
+ 				ifFalse: [aStream nextPutAll: ' wins' translated]].
+ 	type = #losses
+ 		ifTrue: [aNumber = 1
+ 				ifTrue: [aStream nextPutAll: ' loss' translated]
+ 				ifFalse: [aStream nextPutAll: ' losses' translated]]!

Item was added:
+ ----- Method: FreeCellStatistics>>printOn: (in category 'printing') -----
+ printOn: aStream
+ 
+ 	self printSessionOn: aStream.
+ 	aStream cr.
+ 	self printTotalOn: aStream.
+ 	aStream cr.
+ 	self printReplaysOn: aStream.
+ 	aStream cr.
+ 	self printStreaksOn: aStream.!

Item was added:
+ ----- Method: FreeCellStatistics>>printReplaysOn: (in category 'printing') -----
+ printReplaysOn: aStream 
+ 	| total |
+ 	aStream nextPutAll: 'With replays: ' translated;
+ 		 tab.
+ 	self
+ 		print: winsWithReplay
+ 		type: #wins
+ 		on: aStream.
+ 	aStream nextPutAll: ', '.
+ 	self
+ 		print: lossesWithReplay
+ 		type: #losses
+ 		on: aStream.
+ 	total := winsWithReplay + lossesWithReplay.
+ 	total ~~ 0
+ 		ifTrue: [aStream nextPutAll: ', ';
+ 				 print: (winsWithReplay / total * 100) asInteger;
+ 				 nextPut: $%]!

Item was added:
+ ----- Method: FreeCellStatistics>>printSessionOn: (in category 'printing') -----
+ printSessionOn: aStream 
+ 	| total |
+ 	aStream nextPutAll: 'This session: ' translated, String tab.
+ 	self
+ 		print: sessionWins
+ 		type: #wins
+ 		on: aStream.
+ 	aStream nextPutAll: ', '.
+ 	self
+ 		print: sessionLosses
+ 		type: #losses
+ 		on: aStream.
+ 	total := sessionWins + sessionLosses.
+ 	total ~~ 0
+ 		ifTrue: [aStream nextPutAll: ', ';
+ 				 print: (sessionWins / total * 100) asInteger;
+ 				 nextPut: $%]!

Item was added:
+ ----- Method: FreeCellStatistics>>printStreaksOn: (in category 'printing') -----
+ printStreaksOn: aStream 
+ 	aStream nextPutAll: 'Streaks: ' translated;
+ 		 tab;
+ 		 tab.
+ 	self
+ 		print: streakWins
+ 		type: #wins
+ 		on: aStream.
+ 	aStream nextPutAll: ', '.
+ 	self
+ 		print: streakLosses
+ 		type: #losses
+ 		on: aStream.
+ 	aStream cr; tab; tab; tab; tab; nextPutAll: 'Current: ' translated.
+ 	self
+ 		print: currentCount
+ 		type: currentType
+ 		on: aStream!

Item was added:
+ ----- Method: FreeCellStatistics>>printTotalOn: (in category 'printing') -----
+ printTotalOn: aStream 
+ 	| total |
+ 	aStream nextPutAll: 'Total: ' translated;
+ 		 tab;
+ 		 tab;
+ 		 tab.
+ 	self
+ 		print: totalWins
+ 		type: #wins
+ 		on: aStream.
+ 	aStream nextPutAll: ', '.
+ 	self
+ 		print: totalLosses
+ 		type: #losses
+ 		on: aStream.
+ 	total := totalWins + totalLosses.
+ 	total ~~ 0
+ 		ifTrue: [aStream nextPutAll: ', ';
+ 				 print: (totalWins / total * 100) asInteger;
+ 				 nextPut: $%]!

Item was added:
+ ----- Method: FreeCellStatistics>>reset (in category 'actions') -----
+ reset
+ 
+ 	sessionWins 		_ 0.
+ 	sessionLosses 	_ 0.
+ 	totalWins 		_ 0.
+ 	totalLosses 		_ 0.
+ 	streakWins		_ 0.
+ 	streakLosses 	_ 0.
+  	winsWithReplay _ 0.
+ 	lossesWithReplay _ 0.
+ 	lastGameWon	_ 0.
+ 	lastGameLost 	_ 0.
+ 	currentCount 	_ 0.
+ 	currentType		_ nil.
+ 	self changed.
+ 	
+ 
+ 	!

Item was added:
+ ----- Method: FreeCellStatistics>>statsText (in category 'user interface') -----
+ statsText
+ 
+ 	^ String cr,self printString,String cr!

Item was added:
+ ----- Method: FreeCellStatistics>>stringMorphFromPrintOn: (in category 'user interface') -----
+ stringMorphFromPrintOn: aSelector
+ 	
+ 	^StringMorph new 
+ 		contents: (String streamContents: [:s | self perform: aSelector with: s]);
+ 		yourself.!

Item was added:
+ ----- Method: FreeCellStatistics>>updateStreak (in category 'actions') -----
+ updateStreak
+ 	"I moved the code from #printWins:on: and #printLosses:on: here because 
+ 	 it is basically the same. I hope this increases the maintainability. 
+ 	th 12/20/1999 20:41"
+ 	currentType = #losses ifTrue: [streakLosses _ streakLosses max: currentCount].
+ 	currentType = #wins ifTrue: [streakWins _ streakWins max: currentCount]!

Item was added:
+ Object subclass: #FreeTranslation
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-TelNet WordNet'!
+ 
+ !FreeTranslation commentStamp: '<historical>' prior: 0!
+ Squeak interface to the translation server at www.freetranslation.com.  Invoke it in any Squeak text pane by choosing 'translate it' from the shift-menu.  Languages are set by the 'choose language; menu item of the shift menu.  Or by changing (Preferences valueOfFlag: #languageTranslateFrom) and (Preferences valueOfFlag: #languageTranslateTo).   
+ 	See class method openScamperOn:.
+ 
+ 	FreeTranslation openScamperOn: 'Why don''t you ever write anymore?'
+ 
+ !

Item was added:
+ ----- Method: FreeTranslation class>>extract: (in category 'translation') -----
+ extract: aMimeDoc
+ 	| pageSource str |
+ 	"Extract the translated text from the web page"
+ 
+ 	(aMimeDoc content beginsWith: 'error') ifTrue: [^ aMimeDoc content].
+ 	pageSource _ aMimeDoc content.
+ 	"brute force way to pull out the result"
+ 	str _ ReadStream on: pageSource.
+ 	str match: 'Translation Results by Transparent Language'.
+ 	str match: '<p>'.
+ 	^ str upToAll: '</p>'!

Item was added:
+ ----- Method: FreeTranslation class>>openScamperOn: (in category 'scamper') -----
+ openScamperOn: currentSelection
+ 	"Submit the string to the translation server at www.freetranslation.com.  Ask it to translate from (Preferences parameterAt: #languageTranslateFrom) to (Preferences parameterAt: #languageTranslateTo).  Display the results in a Scamper window, reusing the previous one if possible."
+ 
+ 	| inputs scamperWindow from to | 
+ 	currentSelection size >= 10000 ifTrue: [^ self inform: 'Text selection is too long.'].
+ 	from _ Preferences parameterAt: #languageTranslateFrom ifAbsentPut: ['English'].
+ 	to _ Preferences parameterAt: #languageTranslateTo ifAbsentPut: ['German'].
+ 	from = to ifTrue:
+ 			[^ self inform: 'You asked to translate from ', from, ' to ', to, '.\' withCRs,
+ 				'Use "choose language" to set these.'].  
+ 	inputs _ Dictionary new.
+ 	inputs at: 'SrcText' put: (Array with: currentSelection).
+ 	inputs at: 'Sequence' put: #('core').
+ 	inputs at: 'Mode' put: #('html').
+ 	inputs at: 'template' put: #('TextResult2.htm').
+ 	inputs at: 'Language' put: (Array with: from, '/', to).
+ 	scamperWindow _ (WebBrowser default ifNil: [^self]) newOrExistingOn: 'http://ets.freetranslation.com'.
+ 	scamperWindow model submitFormWithInputs: inputs 
+ 		url: 'http://ets.freetranslation.com:5081' asUrl
+ 		method: 'post'.
+ 	scamperWindow activate.
+ !

Item was added:
+ ----- Method: FreeTranslation class>>translate:from:to: (in category 'translation') -----
+ translate: aString from: fromLang to: toLang
+ 	| inputs |
+ 	"Submit the string to the translation server at www.freetranslation.com.  Return the entire web page that freetranslation sends back."
+ 
+ 	aString size >= 10000 ifTrue: [^ self inform: 'Text selection is too long.'].
+ 	inputs _ Dictionary new.
+ 	inputs at: 'SrcText' put: (Array with: aString).
+ 	inputs at: 'Sequence' put: #('core').
+ 	inputs at: 'Mode' put: #('html').
+ 	inputs at: 'template' put: #('TextResult2.htm').
+ 	inputs at: 'Language' put: (Array with: fromLang, '/', toLang).
+ 	^ 'http://ets.freetranslation.com:5081' asUrl postFormArgs: inputs.
+ 	
+ !

Item was added:
+ ----- Method: FreeTranslation class>>translatePanel:fromTo: (in category 'translation') -----
+ translatePanel: buttonPlayer fromTo: normalDirection
+ 	| ow fromTM toTM fromLang toLang tt doc answer width |
+ 	"Gather up all the info I need from the morphs in the button's owner and do the translation.  Insert the results in a TextMorph.  Use www.freeTranslation.com Refresh the banner ad.
+ 	TextMorph with 'from' in the title is starting text.
+ 	PopUpChoiceMorph  with 'from' in the title is the starting language.
+ 	TextMorph with 'from' in the title is place to put the answer.
+ 	PopUpChoiceMorph  with 'from' in the title is the target language.
+ 		If normalDirection is false, translate the other direction."
+ 
+ 	ow _ buttonPlayer costume ownerThatIsA: PasteUpMorph.
+ 	ow allMorphs do: [:mm |
+ 		(mm isTextMorph) ifTrue: [ 
+ 			(mm knownName asString includesSubString: 'from') ifTrue: [
+ 				 fromTM _ mm].
+ 			(mm knownName asString includesSubString: 'to') ifTrue: [
+ 				 toTM _ mm]].
+ 		(mm isKindOf: PopUpChoiceMorph) ifTrue: [ 
+ 			(mm knownName asString includesSubString: 'from') ifTrue: [
+ 				 fromLang _ mm contents asString].
+ 			(mm owner knownName asString includesSubString: 'from') ifTrue: [
+ 				 fromLang _ mm contents asString].
+ 			(mm knownName asString includesSubString: 'to') ifTrue: [
+ 				 toLang _ mm contents asString].
+ 			(mm owner knownName asString includesSubString: 'to') ifTrue: [
+ 				 toLang _ mm contents asString]]].
+ 	normalDirection ifFalse: ["switch"
+ 		tt _ fromTM.  fromTM _ toTM.  toTM _ tt.
+ 		tt _ fromLang.  fromLang _ toLang.  toLang _ tt].
+ 	Cursor wait showWhile: [
+ 		doc _ self translate: fromTM contents asString from: fromLang to: toLang.
+ 		answer _ self extract: doc].	"pull out the translated text"
+ 	
+ 	width _ toTM width.
+ 	toTM contents: answer wrappedTo: width.
+ 	toTM changed.!

Item was added:
+ TextComponent subclass: #FunctionComponent
+ 	instanceVariableNames: 'inputSelectors functionSelector outputSelector outputValue'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Components'!

Item was added:
+ ----- Method: FunctionComponent>>accept (in category 'menu commands') -----
+ accept
+ 	"Inform the model of text to be accepted, and return true if OK."
+ 	| textToAccept oldSelector |
+ 	oldSelector _ functionSelector.
+ 	textToAccept _ textMorph asText.
+ 	textToAccept = self getText ifTrue: [^ self].  "No body to compile yet"
+ 	functionSelector _ model class
+ 		compile: self headerString , textToAccept asString
+ 		classified: 'functions' notifying: nil.
+ 	self setText: textToAccept.
+ 	self hasUnacceptedEdits: false.
+ 	oldSelector ifNotNil:
+ 		[functionSelector = oldSelector ifFalse: [model class removeSelector: oldSelector]].
+ 	self fire!

Item was added:
+ ----- Method: FunctionComponent>>addCustomMenuItems:hand: (in category 'menu') -----
+ addCustomMenuItems: aMenu hand: aHandMorph
+ 	"Add custom menu items"
+ 
+ 	super addCustomMenuItems: aMenu hand: aHandMorph.
+ 	aMenu add: 'add pin' translated target: self selector: #addPin.
+ !

Item was added:
+ ----- Method: FunctionComponent>>addPin (in category 'as yet unclassified') -----
+ addPin 
+ 	| i prev sideLength wasNew |
+ 	wasNew _ self getText = textMorph asText.
+ 	i _ pinSpecs size.
+ 	prev _ pinSpecs last.
+ 	sideLength _ prev pinLoc asInteger odd ifTrue: [self height] ifFalse: [self width].
+ 	pinSpecs _ pinSpecs copyWith:
+ 		(PinSpec new pinName: ('abcdefghi' copyFrom: i to: i) direction: #input
+ 				localReadSelector: nil localWriteSelector: nil
+ 				modelReadSelector: nil modelWriteSelector: nil
+ 				defaultValue: nil pinLoc: prev pinLoc + (8/sideLength) asFloat \\ 4).
+ 	self initFromPinSpecs.
+ 	self addPinFromSpec: pinSpecs last.
+ 	wasNew ifTrue: [self setText: self getText].
+ 	self accept
+ 	!

Item was added:
+ ----- Method: FunctionComponent>>fire (in category 'button') -----
+ fire
+ 	| arguments newValue |
+ 	outputSelector ifNil: [^outputValue := nil].
+ 	functionSelector ifNil: [^outputValue := nil].
+ 	arguments := inputSelectors 
+ 				collect: [:s | s ifNil: [nil] ifNotNil: [model perform: s]].
+ 	newValue := (arguments findFirst: [:a | a isNil]) = 0 
+ 				ifTrue: [model perform: functionSelector withArguments: arguments]
+ 				ifFalse: [nil].
+ 	newValue = outputValue 
+ 		ifFalse: 
+ 			[model perform: outputSelector with: newValue.
+ 			outputValue := newValue]!

Item was added:
+ ----- Method: FunctionComponent>>getText (in category 'model access') -----
+ getText
+ 	| ps |
+ 	^ ('"type a function of' ,
+ 		(String streamContents:
+ 			[:s | 2 to: pinSpecs size do:
+ 				[:i | ps _ pinSpecs at: i.
+ 				(i>2 and: [i = pinSpecs size]) ifTrue: [s nextPutAll: ' and'].
+ 				s nextPutAll: ' ', ps pinName]]) ,
+ 		'"') asText!

Item was added:
+ ----- Method: FunctionComponent>>headerString (in category 'as yet unclassified') -----
+ headerString
+ 	| ps |
+ 	^ String streamContents:
+ 		[:s | s nextPutAll: self knownName.
+ 		2 to: pinSpecs size do:
+ 			[:i | ps _ pinSpecs at: i.
+ 			s nextPutAll: ps pinName , ': ';
+ 				nextPutAll: ps pinName , ' '].
+ 		s cr; tab; nextPutAll: '^ ']!

Item was added:
+ ----- Method: FunctionComponent>>initFromPinSpecs (in category 'components') -----
+ initFromPinSpecs
+ 	outputSelector _ pinSpecs first modelWriteSelector.
+ 	inputSelectors _ (pinSpecs copyFrom: 2 to: pinSpecs size)
+ 						collect: [:ps | ps modelReadSelector]!

Item was added:
+ ----- Method: FunctionComponent>>initPinSpecs (in category 'components') -----
+ initPinSpecs 
+ 	pinSpecs _ Array
+ 		with: (PinSpec new pinName: 'output' direction: #output
+ 				localReadSelector: nil localWriteSelector: nil
+ 				modelReadSelector: nil modelWriteSelector: nil
+ 				defaultValue: nil pinLoc: 3.5)
+ 		with: (PinSpec new pinName: 'a' direction: #input
+ 				localReadSelector: nil localWriteSelector: nil
+ 				modelReadSelector: nil modelWriteSelector: nil
+ 				defaultValue: nil pinLoc: 1.5)
+ !

Item was added:
+ ----- Method: FunctionComponent>>update: (in category 'updating') -----
+ update: aSymbol
+ 	inputSelectors do:
+ 		[:s | aSymbol = s ifTrue: [^ self fire]].!

Item was added:
+ ----- Method: FunctionTile>>sexpWith: (in category '*Etoys-Squeakland-code generation') -----
+ sexpWith: dictionary
+ 	| n elements sel |
+ 	sel _ submorphs first operatorOrExpression.
+ 	n _ SExpElement keyword: #send.
+ 	n attributeAt: #type put: ((owner isMemberOf: TilePadMorph) ifTrue: [owner type] ifFalse: ['Number']).
+ 	elements _ Array with: ((SExpElement keyword: #selector)
+ 					attributeAt: #selector put: sel; yourself)
+ 				with: (argumentPad sexpWith: dictionary).
+ 	n elements: elements.
+ 	^ n.
+ !

Item was added:
+ ----- Method: GSMCodec class>>visibleCodecName (in category '*Etoys-Squeakland-user interface') -----
+ visibleCodecName
+ 	"Answer a name by which this codec can be known externally."
+ 
+ 	^ 'GSM'!

Item was changed:
+ ----- Method: GenericPropertiesMorph>>buttonNamed:action:color:help: (in category 'initialization') -----
- ----- Method: GenericPropertiesMorph>>buttonNamed:action:color:help: (in category 'as yet unclassified') -----
  buttonNamed: aString action: aSymbol color: aColor help: helpString
+ 	"Answer a button with the string provided as label, with the receiver as target, and with the given action; give it the color specified, and associate the given help-sting with it."
  
  	| f col |
+ 	f _ SimpleButtonMorph new
- 	f := SimpleButtonMorph new
  		target: self;
+ 		labelString: aString font: Preferences standardEToysButtonFont;
- 		label: aString;
  		color: aColor;
- 		borderColor: aColor muchDarker;
  		actionSelector: aSymbol;
  		setBalloonText: helpString.
+ 	col _ (self inAColumn: {f}) hResizing: #shrinkWrap.
+ 	^ col!
- 	col := (self inAColumn: {f}) hResizing: #shrinkWrap.
- 	^col!

Item was added:
+ ----- Method: GenericPropertiesMorph>>doGraphPaper (in category '*Etoys-Squeakland-graph paper') -----
+ doGraphPaper
+ 	"Switch to graph paper as a fill style."
+ 
+ 	self putUpGraphPaperPanel!

Item was changed:
+ ----- Method: GenericPropertiesMorph>>lockedString: (in category 'olpc') -----
- ----- Method: GenericPropertiesMorph>>lockedString: (in category 'as yet unclassified') -----
  lockedString: s
+ 	"Answer a StringMorph with the given string as contents, rendered in a font appropriate for deployment within the receiver."
  
+ 	^ (StringMorph contents: s font: Preferences standardEToysFont) lock!
- 	^(StringMorph contents: s) lock.
- !

Item was changed:
  ----- Method: GenericPropertiesMorph>>step (in category 'stepping and presenter') -----
  step
  
  	super step.
+ 	self doEnables.
+ 	myTarget isInWorld ifFalse:[self delete]!
- 	self doEnables!

Item was added:
+ AlignmentMorph subclass: #GoldBoxMenu
+ 	instanceVariableNames: 'scriptor lastItemMousedOver'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Scripting'!
+ 
+ !GoldBoxMenu commentStamp: 'sw 1/11/2006 22:10' prior: 0!
+ A graphical menu that is put up whe the user requests it from the gold-box icon in the header of a Blue scriptor.!

Item was added:
+ ----- Method: GoldBoxMenu>>basicExtentForElements (in category 'initialization') -----
+ basicExtentForElements
+ 	"Answer the nominal thumbnail extent"
+ 
+ 	^ Preferences parameterAt: #goldBoxElementExtent ifAbsentPut: (140 @ 40)
+ 
+ "
+ Preferences setParameter: #goldBoxElementExtent to: (140 @ 40).
+ "!

Item was added:
+ ----- Method: GoldBoxMenu>>initializeFor: (in category 'initialization') -----
+ initializeFor: aScriptor
+ 	"Answer a graphical menu to be put up in conjunction with the Gold Box"
+ 
+ 	| aButton goldBox aReceiver boxBounds example toScale |
+ 	scriptor _ aScriptor.
+ 	lastItemMousedOver _ nil.
+ 	self removeAllMorphs.
+ 	self setProperty: #goldBox toValue: true.
+ 	self listDirection: #topToBottom;
+ 		hResizing: #spaceFill; extent: 1 at 1; vResizing: #spaceFill. "standard #newColumn stuff"
+ 
+ 	self setNameTo: 'Gold Box' translated.
+ 	self useRoundedCorners.
+ 	self color: Color white.
+ 	self borderColor:  (Color r: 1.0 g: 0.839 b: 0.065).
+ 	self hResizing: #shrinkWrap; vResizing: #shrinkWrap; borderWidth: 4.
+ 	{
+ 	{ScriptingSystem. #yesNoComplexOfTiles.  'test' translated. 'Test/Yes/No panes for testing a condition.'  translated}.
+ 	{ScriptingSystem. #timesRepeatComplexOfTiles. 'repeat'  translated.  'TimesRepeat panes for running a section of code repeatedly.'  translated}.
+ 	{ ScriptingSystem.	#randomNumberTile.	 'random'  translated.		'A tile that will produce a random number in a given range.'  translated}.
+ 	{ ScriptingSystem.	#seminalFunctionTile.	 'function'  translated.		'A tile representing a function call.  Click on the function name or the arrows to change functions.'  translated}.
+ 	{ScriptingSystem.	#buttonUpTile.	 'button up?'  translated.		'Reports whether the mouse button is up'  translated}.
+ 	{ScriptingSystem.	#buttonDownTile.	 'button down?'  translated.		'Reports whether the mouse button is down'  translated}.
+ 	{scriptor playerScripted. #tileToRefer.  'tile for me'  translated. 'A tile representing the object being scripted'  translated}.
+ 	{self.  #numericConstantTile.  'number'  translated.   'A tile holding a plain number'  translated}.
+ } do:
+ 		[:tuple |
+ 			aReceiver _ tuple first.
+ 			example := aReceiver perform: tuple second.
+ 			
+ 			aButton := IconicButton new target: aReceiver.
+ 			aButton borderWidth: 0;
+ 				color: Color transparent.
+ 			toScale := tuple size >= 5
+ 				ifTrue:
+ 					[tuple first perform: tuple fifth]  "bail-out for intractable images."
+ 				ifFalse:
+ 					[example imageForm].
+ 			aButton labelGraphic: (toScale copy scaledToHeight: 40).
+ 
+ 			aButton actionSelector: #launchPartOffsetVia:label:.
+ 			aButton arguments: {tuple second.  tuple third}.
+ 			(tuple size > 3 and: [tuple fourth isEmptyOrNil not]) ifTrue:
+ 				[aButton setBalloonText: tuple fourth].
+ 			aButton actWhen: #buttonDown.
+ 			aButton on: #mouseEnter send: #mousedOverEvent:button:  to: self.
+ 			aButton on: #click send: #delete to: self.
+  			self addMorphBack: aButton].
+ 	goldBox _ aScriptor submorphs first submorphThat: [:m | (m isKindOf: SimpleButtonMorph) and: [m actionSelector == #offerGoldBoxMenu]] ifNone: [nil].
+ 	goldBox
+ 		ifNil:
+ 			[self position: ActiveHand position]
+ 		ifNotNil:
+ 			[boxBounds _ goldBox boundsInWorld.
+ 			self center: boxBounds center.
+ 			self left: (boxBounds center x - (self width // 2)).
+ 			self top: boxBounds bottom].
+ 	lastItemMousedOver _ nil.
+ 	self on: #mouseLeave send: #mouseLeftMenuWithEvent: to: self.
+ 	self on: #mouseLeaveDragging send: #delete to: self.!

Item was added:
+ ----- Method: GoldBoxMenu>>mouseLeftMenuWithEvent: (in category 'initialization') -----
+ mouseLeftMenuWithEvent: evt
+ 	"The mouse, having been within the menu, has now left it.  Formerly:  Depending on how the departure takes place, we either do or don't hand the user a prototype object, but in any case we ourselves vanish.  Currently:  we do *not* tear off a new instance, but rather simply delete the open gold-box."
+ 	
+ 	false ifTrue:
+ 		[lastItemMousedOver ifNotNil:
+ 			[((evt position x <= self left) or: [evt position x >= self right])  "off to sides"
+ 				ifTrue:
+ 					[lastItemMousedOver doButtonAction]]].
+ 
+ 	self delete!

Item was added:
+ ----- Method: GoldBoxMenu>>mousedOverEvent:button: (in category 'initialization') -----
+ mousedOverEvent: evt button: aButton
+ 	"The mouse came over a button in my panel; make a note of it, and  instigate its mouseover highlighting"
+ 
+ 	lastItemMousedOver _ aButton.
+ 	aButton borderThick!

Item was added:
+ ----- Method: GoldBoxMenu>>numericConstantTile (in category 'initialization') -----
+ numericConstantTile
+ 	"Answer a bare numeric-constant tile."
+ 
+ 	| aTile |
+ 	aTile := (Vocabulary vocabularyNamed: 'Number')  defaultArgumentTile.
+ 	aTile vResizing: #shrinkWrap.
+ 	^ aTile!

Item was added:
+ ----- Method: GrabPatchMorph>>justTornOffFromPartsBin (in category '*Etoys-Squeakland-initialization') -----
+ justTornOffFromPartsBin
+ 	super justTornOffFromPartsBin.
+ 	self image: (Form extent: 0 @ 0).	"hide the icon"
+ 	ActiveHand showTemporaryCursor: Cursor crossHair!

Item was added:
+ ----- Method: GrafPort>>displayScannerForMulti:foreground:background:ignoreColorChanges: (in category '*Etoys-Squeakland-accessing') -----
+ displayScannerForMulti: para foreground: foreColor background: backColor ignoreColorChanges: shadowMode
+ 
+ 	((para isMemberOf: MultiNewParagraph) or: [para text string isByteString]) ifTrue: [
+ 		^ (MultiDisplayScanner new text: para presentationText textStyle: para textStyle
+ 				foreground: foreColor background: backColor fillBlt: self
+ 				ignoreColorChanges: shadowMode)
+ 			setPort: self clone
+ 	].
+ 	^ (DisplayScanner new text: para text textStyle: para textStyle
+ 			foreground: foreColor background: backColor fillBlt: self
+ 			ignoreColorChanges: shadowMode)
+ 		setPort: self clone
+ !

Item was changed:
  ----- Method: GraphMorph class>>additionsToViewerCategories (in category '*eToys-scripting') -----
  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."
  
  	^ #(
  
  	(basic (
+ (slot cursor 	'The current cursor location, wrapped back to the beginning if appropriate' Number	 readWrite Player getGraphCursor Player setCursorWrapped:)
- (slot cursor 	'The current cursor location, wrapped back to the beginning if appropriate' Number	 readWrite Player getCursor Player setCursorWrapped:)
  
  (slot sampleAtCursor	'The sample value at the current cursor location' Number readWrite Player getSampleAtCursor Player setSampleAtCursor:)))
  
  	(sampling (
  (slot cursor 	'The current cursor location, wrapped back to the beginning if appropriate' Number	 readWrite Player getCursor Player setCursorWrapped:)
  (slot sampleAtCursor	'The sample value at the current cursor location' Number readWrite Player getSampleAtCursor Player setSampleAtCursor:)
  (slot lastValue 'The last value obtained' Number readWrite	Player getLastValue Player setLastValue:)
+ (slot samplingRate '11025, 22050, 44100' SamplingRate readWrite Player getSamplingRate Player setSamplingRate:)
  (command clear 'Clear the graph of current contents')
  (command loadSineWave 'Load a sine wave as the current graph')
  (command loadSound: 'Load the specified sound into the current graph' Sound)
  (command reverse 'Reverse the graph')
+ (command playFromCursorTo: 'Play the current graph as a sound' Number)
+ (slot count 'How many elements are within me' Number readOnly Player getCount unused unused)
  (command play 'Play the current graph as a sound'))))!

Item was added:
+ ----- Method: GraphMorph>>elementCount (in category '*Etoys-Squeakland-accessing') -----
+ elementCount
+ 	^data size!

Item was added:
+ ----- Method: GraphMorph>>getSamplingRate (in category '*Etoys-Squeakland-accessing') -----
+ getSamplingRate
+ 	^samplingRate asString asSymbol!

Item was added:
+ ----- Method: GraphMorph>>play (in category '*Etoys-Squeakland-commands') -----
+ play
+ 	self playOnce: data size!

Item was added:
+ ----- Method: GraphMorph>>playFromCursorTo: (in category '*Etoys-Squeakland-commands') -----
+ playFromCursorTo: aSampleNumber
+ 	self playOnce: aSampleNumber!

Item was added:
+ ----- Method: GraphMorph>>playOnce: (in category '*Etoys-Squeakland-commands') -----
+ playOnce: aSampleNumber 
+ 	| scale absV scaledData sampleNumber |
+ 	sampleNumber := aSampleNumber.
+ 	data isEmpty
+ 		ifTrue: [^ self]. "nothing to play"
+ 	sampleNumber < cursor ifTrue: [^ self]. 
+ 	scale := 1.
+ 	data
+ 		do: [:v | (absV := v abs) > scale
+ 				ifTrue: [scale := absV]].
+ 	scale := 32767.0 / scale.
+ 	scaledData := SoundBuffer newMonoSampleCount: sampleNumber - cursor.
+ 	1
+ 		to: sampleNumber - cursor
+ 		do: [:i | scaledData at: i put: (scale
+ 					* (data
+ 							at: (i + cursor min: data size max: 1))) truncated].
+ 	SoundService default playSampledSound: scaledData rate: samplingRate!

Item was added:
+ ----- Method: GraphMorph>>samplingRate (in category '*Etoys-Squeakland-accessing') -----
+ samplingRate
+     ^samplingRate!

Item was added:
+ ----- Method: GraphMorph>>samplingRate: (in category '*Etoys-Squeakland-accessing') -----
+ samplingRate: aSamplingRate
+ 	((SamplingRate resolutions) includes:  aSamplingRate) ifFalse: [^ self].
+ 	samplingRate:= aSamplingRate!

Item was added:
+ ----- Method: GraphMorph>>setSamplingRate: (in category '*Etoys-Squeakland-accessing') -----
+ setSamplingRate: aSymbol
+ 	samplingRate :=  aSymbol asString asNumber!

Item was added:
+ GenericPropertiesMorph subclass: #GraphPaperPanel
+ 	instanceVariableNames: 'backgroundColor gridColor gridEvery showDarkerGridAlso darkerGridColor darkerGridEvery offset'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Experimental'!
+ 
+ !GraphPaperPanel commentStamp: 'sw 2/29/2012 14:44' prior: 0!
+ A panel for authoring "graph paper"
+ 	backgroundColor -- the color of the ground
+ 	gridColor -- the color of the fine lines
+ 	gridEvery -- number of pixels between fine grid lines.
+ 	darkerGridColor -- color of the secondary, less-frequently-drawn grid
+ 	darkerLineEvery -- number of primary grid units between darker grid lines
+ 	offset -- the offset of the InfiniteForm produced.!

Item was added:
+ ----- Method: GraphPaperPanel class>>classicCartesianGraph (in category 'examples') -----
+ classicCartesianGraph
+ 	"Answer a nicely configured playfield with horizontal and vertical axes and a background well-suited for determining units on the plane."
+ 
+ 	| aPlayfield horiz vert pixelsPerUnit parms |
+ 	aPlayfield := PasteUpMorph new extent: 642 @ 642.
+ 	horiz := HorizontalNumberLineMorph new.
+ 	horiz width: 640.
+ 
+ 	aPlayfield addMorphBack: horiz.
+ 	vert := VerticalNumberLineMorph new.
+ 	vert height: 640.
+ 	aPlayfield addMorphBack: vert.
+ 
+ 	pixelsPerUnit := 16.
+ 
+ 	horiz center: (aPlayfield center + (0 @ -2)).
+ 	vert center: (aPlayfield center + (-14 @ -2)).
+ 
+ 	horiz minValue: -20 pixelsPerUnit: pixelsPerUnit unitsPerMark: 1 marksPerLegend: 5.
+ 	vert minValue: -20 pixelsPerUnit: pixelsPerUnit unitsPerMark: 1 marksPerLegend: 5.
+ 
+ 	horiz registerGraphCoordinate: 0 atPlayfieldLocation: 322.
+ 	vert registerGraphCoordinate: 0 atPlayfieldLocation: 318.
+ 	vert showZero: false.
+ 
+ 	parms := GraphPaperParameters backgroundColor: Color green muchLighter gridColor: Color blue muchLighter gridEvery: 16 showDarkerGridAlso: true darkerGridColor: Color blue muchDarker darkerGridEvery: 10 offset: (0 @ 0).
+ 	aPlayfield establishGraphPaperFrom: parms.
+ 
+ 	horiz update.
+ 	vert update.
+ 
+ 	"temporary fudges to get this basically looking right, though there had been hope that the above attempts would have already succeded..."
+ 	WorldState addDeferredUIMessage:
+ 		[vert y: 296.
+ 		vert maxValue: 20.
+ 		horiz y: 314.
+ 		horiz maxValue: 20].
+ 
+ 	^ aPlayfield
+ 
+ "
+ GraphPaperPanel classicCartesianGraph openInHand
+ "!

Item was added:
+ ----- Method: GraphPaperPanel class>>simpleGraphPaper (in category 'examples') -----
+ simpleGraphPaper
+ 	"Answer a playfield set up with simple graph paper."
+ 
+ 	| aPlayfield parms |
+ 	aPlayfield := PasteUpMorph new extent: 640 @ 480.
+ 
+ 	parms := GraphPaperParameters backgroundColor: Color lightYellow gridColor: Color lightGreen lighter lighter gridEvery: 16 showDarkerGridAlso: true darkerGridColor: Color green lighter darkerGridEvery: 10 offset: (0 @ 0).
+ 	aPlayfield establishGraphPaperFrom: parms.
+ 
+ 	^ aPlayfield
+ 
+ "
+ GraphPaperPanel simpleGraphPaper openInHand
+ "!

Item was added:
+ ----- Method: GraphPaperPanel class>>supplementaryPartsDescriptions (in category 'parts-bin') -----
+ 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: 'x-y plane' translatedNoop
+ 		categoryList: {'Graphing' translatedNoop}
+ 		documentation: 
+ 			'an x-y plane with x and y axes' translatedNoop
+ 		globalReceiverSymbol: #GraphPaperPanel
+ 		nativitySelector: #classicCartesianGraph.
+ 
+ 	DescriptionForPartsBin
+ 		formalName: 'graph paper' translatedNoop
+ 		categoryList: {'Graphing' translatedNoop}
+ 		documentation: 
+ 			'simple graph paper' translatedNoop
+ 		globalReceiverSymbol: #GraphPaperPanel
+ 		nativitySelector: #simpleGraphPaper.
+ 
+ 	"DescriptionForPartsBin
+ 		formalName: 'Broad x-y plane' translatedNoop
+ 		categoryList: {'Graphing' translatedNoop}
+ 		documentation: 
+ 			'an x-y plane with axes covering a range from -20 to 20' translatedNoop
+ 		globalReceiverSymbol: #GraphPaperPanel
+ 		nativitySelector: #largerCartesianGraph.
+ 
+ 	DescriptionForPartsBin
+ 		formalName: 'First quadrant' translatedNoop
+ 		categoryList: {'Graphing' translatedNoop}
+ 		documentation: 
+ 			'the first quadrant of an x-y plane' translatedNoop
+ 		globalReceiverSymbol: #GraphPaperPanel
+ 		nativitySelector: #firstQuadrantGraph."
+ }!

Item was added:
+ ----- Method: GraphPaperPanel>>adjustOffset: (in category 'adjusting parameters') -----
+ adjustOffset: aFractionalPoint
+ 	"Adjust the offset to reflect the value embodied in the argument supplied."
+ 
+ 	| constrained |
+ 	constrained := aFractionalPoint min: (1 @ 1) max: (-1 @ -1).
+ 	offset := (constrained * self gridEvery asPoint) rounded.
+ 	self showSliderFeedback: offset.
+ 	self makeToolReflectCurrentSettings!

Item was added:
+ ----- Method: GraphPaperPanel>>backgroundColor (in category 'accessing') -----
+ backgroundColor
+ 	"Answer the value of backgroundColor"
+ 
+ 	^ backgroundColor!

Item was added:
+ ----- Method: GraphPaperPanel>>backgroundColor: (in category 'accessing') -----
+ backgroundColor: anObject
+ 	"Set the value of backgroundColor"
+ 
+ 	backgroundColor := anObject.
+ 	self makeToolReflectCurrentSettings!

Item was added:
+ ----- Method: GraphPaperPanel>>colorPickerFor:getter:setter: (in category 'private') -----
+ colorPickerFor: target getter: getterSymbol setter: setterSymbol
+ 	"Answer a color picker for the given target, getter, and setter, for use in the panel."
+ 
+ 	^ ColorPickerMorph new
+ 		noChart: true;
+ 		initializeForGraphPaperPanel;
+ 		target: target;
+ 		selector: setterSymbol;
+ 		originalColor: (target perform: getterSymbol)!

Item was added:
+ ----- Method: GraphPaperPanel>>darkerGridColor (in category 'accessing') -----
+ darkerGridColor
+ 	"Answer the value of darkerGridColor."
+ 
+ 	^ darkerGridColor!

Item was added:
+ ----- Method: GraphPaperPanel>>darkerGridColor: (in category 'accessing') -----
+ darkerGridColor: anObject
+ 	"Set the value of darkerGridColor."
+ 
+ 	darkerGridColor := anObject.
+ 	self makeToolReflectCurrentSettings!

Item was added:
+ ----- Method: GraphPaperPanel>>darkerGridEvery (in category 'accessing') -----
+ darkerGridEvery
+ 	"Answer the value of darkerGridEvery."
+ 
+ 	^ darkerGridEvery!

Item was added:
+ ----- Method: GraphPaperPanel>>darkerGridEvery: (in category 'accessing') -----
+ darkerGridEvery: aNumber
+ 	"Set the value of darkerGridEvery."
+ 
+ 	darkerGridEvery := aNumber rounded.
+ 	self harmonizeGridEvery.
+ 	self makeToolReflectCurrentSettings!

Item was added:
+ ----- Method: GraphPaperPanel>>doAccept (in category 'accepting') -----
+ doAccept
+ 	"The user hit 'accept' -- have the target remember the parameters embodied, and dismiss the panel."
+ 
+ 	myTarget renderedMorph establishGraphPaperFrom: (GraphPaperParameters new fillFrom: self).
+ 	self delete!

Item was added:
+ ----- Method: GraphPaperPanel>>doApply (in category 'accepting') -----
+ doApply
+ 	"The user hit 'apply' -- have the target remember the parameters embodied.  Keep the panel up.   If user makes any further changes in the panel but then hits cancel, fill style will revert to the version saved here."
+ 
+ 	myTarget renderedMorph establishGraphPaperFrom: (GraphPaperParameters new fillFrom: self).
+ 	thingsToRevert at: #fillStyle: put: myTarget fillStyle.
+ !

Item was added:
+ ----- Method: GraphPaperPanel>>doEnables (in category 'private') -----
+ doEnables
+ 	"Carry out appropriate enablings within the receiver's interior."
+ 
+ 	| itsName existing |
+ 	existing := darkerGridEvery.
+ 	self harmonizeCoarseGrid.
+ 	existing = darkerGridEvery ifFalse:
+ 		[self makeToolReflectCurrentSettings].
+ 
+ 	self allMorphsDo: [ :each |
+ 		itsName := each knownName.
+ 		(#(pickerForDarkerGrid darkerGridEvery) includes: itsName) ifTrue:
+ 			[self enable: each when: self showDarkerGridAlso].
+ 		(#(offset) includes: itsName) ifTrue:
+ 			[self enable: each when: true]]!

Item was added:
+ ----- Method: GraphPaperPanel>>doSolidColor (in category 'private') -----
+ doSolidColor
+ 	"Abandon use of graph paper; use the prevailing background as the new solid color."
+ 
+ 	myTarget color: self backgroundColor.
+ 	self delete.
+ 	myTarget openAppropriatePropertySheet!

Item was added:
+ ----- Method: GraphPaperPanel>>gridColor (in category 'accessing') -----
+ gridColor
+ 	"Answer the value of gridColor"
+ 
+ 	^ gridColor!

Item was added:
+ ----- Method: GraphPaperPanel>>gridColor: (in category 'accessing') -----
+ gridColor: anObject
+ 	"Set the value of gridColor."
+ 
+ 	gridColor := anObject.
+ 	self makeToolReflectCurrentSettings!

Item was added:
+ ----- Method: GraphPaperPanel>>gridEvery (in category 'accessing') -----
+ gridEvery
+ 	"Answer the value of gridEvery."
+ 
+ 	^ gridEvery!

Item was added:
+ ----- Method: GraphPaperPanel>>gridEvery: (in category 'accessing') -----
+ gridEvery: aNumber
+ 	"Set the value of gridEvery"
+ 
+ 	gridEvery := aNumber rounded.
+ 	self harmonizeCoarseGrid.
+ 	self makeToolReflectCurrentSettings!

Item was added:
+ ----- Method: GraphPaperPanel>>harmonizeCoarseGrid (in category 'adjusting parameters') -----
+ harmonizeCoarseGrid
+ 	"The pixelsPerUnit having changed, reconsider  'darkerGridEvery'  and the slider that governs it."
+ 
+ 	| aSlider maxGridEvery |
+ 	maxGridEvery := self maxValueForCoarseGrid.
+ 	darkerGridEvery := darkerGridEvery min:  maxGridEvery max: 2.
+ 	aSlider := self deepSubpartNamed: #darkerGridEverySlider.
+ 	aSlider ifNotNil:
+ 		[aSlider setMaxVal: maxGridEvery.
+ 		aSlider adjustToValue: darkerGridEvery]
+ 
+ 	!

Item was added:
+ ----- Method: GraphPaperPanel>>harmonizeGridEvery (in category 'adjusting parameters') -----
+ harmonizeGridEvery
+ 	"Other metrics having possibly changed, make sure the gridEvery variable is within range and that its slider offers a reasonable range of values."
+ 
+ 	| aSlider maxGridEvery |
+ 	maxGridEvery := self maxValueForGridEvery.
+ 	gridEvery := gridEvery min:  maxGridEvery max: 10.
+ 	aSlider := self deepSubpartNamed: #gridEverySlider.
+ 	aSlider ifNotNil:
+ 		[aSlider setMaxVal: maxGridEvery.
+ 		aSlider adjustToValue: gridEvery]
+ 
+ 	!

Item was added:
+ ----- Method: GraphPaperPanel>>hasTarget: (in category 'accessing') -----
+ hasTarget: aMorph
+ 	"Answer whether the receiver's target is the morph in question."
+ 
+ 	^ aMorph renderedMorph == myTarget!

Item was added:
+ ----- Method: GraphPaperPanel>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver.  Notice that, because of GenericPropertiesMorph's custom, 'myTarget' is already set before this is called."
+ 
+ 	| existing toUse |
+ 	super initialize.
+ 	existing := myTarget renderedMorph valueOfProperty: #graphPaperParameters.
+ 	toUse := existing
+ 		ifNotNil:
+ 			[existing deepCopy]
+ 		ifNil:
+ 			[GraphPaperParameters new].
+ 	backgroundColor := existing
+ 		ifNotNil:	
+ 			[toUse backgroundColor]
+ 		ifNil:
+ 			[myTarget color asColor].
+ 	gridColor := toUse gridColor.
+ 	gridEvery := toUse gridEvery.
+ 	showDarkerGridAlso := toUse showDarkerGridAlso.
+ 	darkerGridColor := toUse darkerGridColor.
+ 	darkerGridEvery := toUse darkerGridEvery.
+ 	offset := toUse showDarkerGridAlso ifTrue: [toUse offset] ifFalse: [0 @ 0].
+ 
+ 	thingsToRevert at: #fillStyle: put: myTarget fillStyle.
+ 	self rebuild.
+ 
+ 	self makeToolReflectCurrentSettings
+ 
+ 	!

Item was added:
+ ----- Method: GraphPaperPanel>>makeToolReflectCurrentSettings (in category 'accessing') -----
+ makeToolReflectCurrentSettings
+ 	"Make the appropriate item reflect graph-paper corresponding to current settings."
+ 
+ 	myTarget color: (GraphPaperParameters new fillFrom: self) asInfiniteForm!

Item was added:
+ ----- Method: GraphPaperPanel>>maxValueForCoarseGrid (in category 'adjusting parameters') -----
+ maxValueForCoarseGrid
+ 	"Given the pixelsPerUnit and the dimensions of my target, determine and answer a plausible maximum value for the coarse-grid multiplier."
+ 
+ 	| maxDimension |
+ 	maxDimension := myTarget width max: myTarget height.
+ 	^ ((maxDimension // gridEvery) - 1) max: 2!

Item was added:
+ ----- Method: GraphPaperPanel>>maxValueForGridEvery (in category 'adjusting parameters') -----
+ maxValueForGridEvery
+ 	"Answer the largest plausible value for gridEvery"
+ 
+ 	| maxDimension |
+ 	maxDimension := myTarget width max: myTarget height.
+ 	^ self showDarkerGridAlso
+ 		ifTrue:
+ 			[maxDimension // darkerGridEvery]
+ 		ifFalse:
+ 			[(maxDimension - 1) max: 10]!

Item was added:
+ ----- Method: GraphPaperPanel>>offset (in category 'accessing') -----
+ offset
+ 	"Answer the value of offset"
+ 
+ 	^ offset!

Item was added:
+ ----- Method: GraphPaperPanel>>offset: (in category 'accessing') -----
+ offset: anObject
+ 	"Set the value of offset"
+ 
+ 	offset := anObject!

Item was added:
+ ----- Method: GraphPaperPanel>>paneForBackgroundColorPicker (in category 'panes') -----
+ paneForBackgroundColorPicker
+ 	"Answer a pane for governing the background color."
+ 
+ 	^ self 
+ 		inAColumn: {
+ 			(self inAColumn: {
+ 				self colorPickerFor: self
+ 						 getter: #backgroundColor setter: #backgroundColor:.
+ 				self lockedString: 'paper color' translated.
+ 			}
+ 			named: #pickerForBackground) layoutInset: 0.
+ 		}
+ !

Item was added:
+ ----- Method: GraphPaperPanel>>paneForDarkerGridColorPicker (in category 'panes') -----
+ paneForDarkerGridColorPicker
+ 	"Answer a pane for governing the secondary line color."
+ 
+ 	^ self 
+ 		inAColumn: {
+ 			(self inAColumn: {
+ 				self colorPickerFor: self
+ 						 getter: #darkerGridColor setter: #darkerGridColor:.
+ 				self lockedString: 'coarse grid color' translated.
+ 			}
+ 			named: #pickerForDarkerGrid) layoutInset: 0.
+ 		}
+ !

Item was added:
+ ----- Method: GraphPaperPanel>>paneForDarkerGridEvery (in category 'panes') -----
+ paneForDarkerGridEvery
+ 	"Answer a pane for the darkerGridEvery datum."
+ 
+ 	| aSlider |
+ 	aSlider :=  SimpleSliderMorph new
+ 		color: color darker;
+ 		extent: 100 at 28;
+ 		target: self;
+ 		minVal: 2;
+ 		maxVal: 40;
+ 		actionSelector: #darkerGridEvery:;
+ 		setNameTo: #darkerGridEverySlider;
+ 		adjustToValue: self darkerGridEvery.
+ 
+ 	^ (self inARow: {
+ 			(UpdatingStringMorph new)
+ 				getSelector: #darkerGridEvery;
+ 				putSelector: #darkerGridEvery:;
+ 				target: self;
+ 				growable: false;
+ 				decimalPlaces: 0;
+ 				minimumWidth: 40;
+ 				maximumWidth: 40;
+ 				yourself.
+ 			aSlider}) setNameTo: #darkerGridEvery; yourself!

Item was added:
+ ----- Method: GraphPaperPanel>>paneForExtras (in category 'panes') -----
+ paneForExtras
+ 	"Answer a pane for the checkbox and buttons"
+ 
+ 	^ self 
+ 		inAColumn: {
+ 			self transparentSpacerOfSize: (10 @ 20).
+ 			self paneForGridEvery.
+ 			self transparentSpacerOfSize: (10 @ 40).
+ 			self paneForSecondaryGridToggle.
+ 			self transparentSpacerOfSize: (10 @ 10).
+ 			self paneForDarkerGridEvery.
+ 			self transparentSpacerOfSize: (10 @ 40).
+ 			self paneForOffset.
+ 			self transparentSpacerOfSize: (10 @ 40).
+ 		} 
+ 		named: #paneForExtras.!

Item was added:
+ ----- Method: GraphPaperPanel>>paneForGridColorPicker (in category 'panes') -----
+ paneForGridColorPicker
+ 	"Answer a pane for governing the grid color."
+ 
+ 	^ self 
+ 		inAColumn: {
+ 			(self inAColumn: {
+ 				self colorPickerFor: self
+ 						 getter: #gridColor setter: #gridColor:.
+ 				self lockedString: 'grid color' translated.
+ 			}
+ 			named: #pickerForGrid) layoutInset: 0.
+ 		}
+ !

Item was added:
+ ----- Method: GraphPaperPanel>>paneForGridEvery (in category 'panes') -----
+ paneForGridEvery
+ 	"Answer a pane to govern the gridEvery datum."
+ 
+ 	| aSlider |
+ 	aSlider :=  SimpleSliderMorph new
+ 		color: color darker;
+ 		extent: 100 at 28;
+ 		target: self;
+ 		minVal: 4;
+ 		maxVal: 360;
+ 		actionSelector: #gridEvery:;
+ 		setNameTo: #gridEverySlider;
+ 		adjustToValue: self gridEvery.
+ 
+ 	^ self inARow: {
+ 		self lockedString: ('grid size' translated, '  ').
+ 		(UpdatingStringMorph new)
+ 				getSelector: #gridEvery;
+ 				putSelector: #gridEvery:;
+ 				target: self;
+ 				growable: false;
+ 				decimalPlaces: 0;
+ 				minimumWidth: 40;
+ 				maximumWidth: 40;
+ 				yourself.
+ 			aSlider}!

Item was added:
+ ----- Method: GraphPaperPanel>>paneForOffset (in category 'panes') -----
+ paneForOffset
+ 	"Answer a pane for the Offset button."
+ 
+ 	| aPane |
+ 	aPane := (self inARow: {
+ 		self
+ 			buildFakeSlider: 'Offset' translated
+ 			selector: #adjustOffset:
+ 			help: 'Drag in here to change the offset' translated
+ 				}) hResizing: #shrinkWrap.
+ 	aPane setNameTo: #offset.
+ 	^ aPane
+ 
+ !

Item was added:
+ ----- Method: GraphPaperPanel>>paneForSecondaryGridToggle (in category 'panes') -----
+ paneForSecondaryGridToggle
+ 	"Answer a pane to govern the secondary grid."
+ 
+ 	^ self inARow: {
+ 		self
+ 			directToggleButtonFor: self 
+ 			getter: #showDarkerGridAlso
+ 			setter: #toggleShowDarkerGridAlso
+ 			help: 'Also show coarse grid' translated.
+ 		self lockedString: ' coarse grid' translated.
+ 	}
+ !

Item was added:
+ ----- Method: GraphPaperPanel>>rebuild (in category 'initialization') -----
+ rebuild
+ 	"Rebuild the contents of the property sheet."
+ 
+ 	| buttons |
+ 	self removeAllMorphs.
+ 	self addARow: {
+ 		self lockedString: myTarget topRendererOrSelf externalName
+ 		"self lockedString: ('Graph paper for {1}' translated format: {myTarget topRendererOrSelf externalName})".
+ 	}.
+ 
+ 	self addARow: {
+ 		self paneForBackgroundColorPicker.
+ 		self paneForGridColorPicker.
+ 
+ 	}.
+ 	self addARow: {
+ 		self paneForExtras.
+ 		self paneForDarkerGridColorPicker.
+ 	}.
+ 
+ 	buttons := OrderedCollection new.
+ 	buttons addAll: {
+ 		self 
+ 			buttonNamed: 'Apply' translated action: #doApply color: color lighter 
+ 			help: 'keep changes made thus far, but keep panel open' translated.
+ 		self 
+ 			buttonNamed: 'Accept' translated action: #doAccept color: color lighter 
+ 			help: 'keep changes made and close panel' translated.
+ 		self 
+ 			buttonNamed: 'Cancel' translated action: #doCancel color: color lighter 
+ 			help: 'cancel changes made and close panel' translated.
+ 		self  transparentSpacerOfSize: (100 @ 1).
+ 		self buttonNamed: 'Solid color' translated action: #doSolidColor color: color lighter help: 'abandon graph paper, use a solid color instead' translated
+ 	}.
+ 	
+ 	self addARow: buttons!

Item was added:
+ ----- Method: GraphPaperPanel>>showDarkerGridAlso (in category 'accessing') -----
+ showDarkerGridAlso
+ 	"Answer the value of showDarkerGridAlso"
+ 
+ 	^ showDarkerGridAlso!

Item was added:
+ ----- Method: GraphPaperPanel>>showDarkerGridAlso: (in category 'accessing') -----
+ showDarkerGridAlso: anObject
+ 	"Set the value of showDarkerGridAlso"
+ 
+ 	showDarkerGridAlso := anObject!

Item was added:
+ ----- Method: GraphPaperPanel>>toggleShowDarkerGridAlso (in category 'adjusting parameters') -----
+ toggleShowDarkerGridAlso
+ 	"Toggle whether a secondary grid should be shown."
+ 
+ 	showDarkerGridAlso := self showDarkerGridAlso not.
+ 	showDarkerGridAlso ifTrue: [offset := 0].
+ 	self rebuild.
+ 	self doEnables.
+ 	self makeToolReflectCurrentSettings!

Item was added:
+ Object subclass: #GraphPaperParameters
+ 	instanceVariableNames: 'backgroundColor gridColor gridEvery showDarkerGridAlso darkerGridColor darkerGridEvery offset'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Experimental'!
+ 
+ !GraphPaperParameters commentStamp: 'sw 2/29/2012 15:04' prior: 0!
+ parameters that define "graph paper".  
+ 	backgroundColor	the color of the "paper"
+ 	gridColor 				the color of the finest grid lines
+ 	gridEvery				pixels per fine grid
+ 	darkerGridColor		the color of the coarser grid lines
+ 	darkerLineEvery		fine grid lines per coarser grid line
+ 	offset					offset point for the infinite form!

Item was added:
+ ----- Method: GraphPaperParameters class>>backgroundColor:gridColor:gridEvery:showDarkerGridAlso:darkerGridColor:darkerGridEvery:offset: (in category 'instance creation') -----
+ backgroundColor: bgColor gridColor: gridColor gridEvery: pixelsPerGrid showDarkerGridAlso: aBoolean darkerGridColor: darkerGridColor darkerGridEvery: gridsPerDarkerGrid offset: offsetPoint
+ 	"Answer a new GraphPaperParameters instance holding the values provided."
+ 
+ 	| parms |
+ 	parms := self new.
+ 	parms backgroundColor: bgColor.
+ 	parms gridColor: gridColor.
+ 	parms gridEvery: pixelsPerGrid.
+ 	parms showDarkerGridAlso: aBoolean.
+ 	parms darkerGridColor: darkerGridColor.
+ 	parms darkerGridEvery: gridsPerDarkerGrid.
+ 	parms offset: offsetPoint asPoint.
+ 	^ parms!

Item was added:
+ ----- Method: GraphPaperParameters class>>oneTierGridFormOrigin:grid:background:line: (in category 'form creation') -----
+ oneTierGridFormOrigin: origin grid: smallGrid  background: backColor line: lineColor
+ 	"Answer an infinite form that repeats as a simple grid."
+ 
+ 	^ Morph basicNew gridFormOrigin: origin grid: smallGrid asPoint background: backColor line: lineColor
+ 
+ "
+ 	| aPlayfield |
+ 	aPlayfield := PasteUpMorph authoringPrototype extent: 640 @ 480.
+ 	aPlayfield color: (GraphPaperParameters oneTierGridFormOrigin: (0 at 0) grid: 16 background: Color green muchLighter line: Color blue muchLighter).
+ 	aPlayfield openInHand
+ "
+ !

Item was added:
+ ----- Method: GraphPaperParameters class>>twoTierGridFormOrigin:grid:background:line:darkerGridEvery:darkerGridColor: (in category 'form creation') -----
+ twoTierGridFormOrigin: origin grid: smallGrid  background: backColor line: lineColor darkerGridEvery: darkerGridEvery darkerGridColor: darkerGridColor
+ 	"Answer an infinite form that repeats a pattern involving grid lines with darker ones at regular intervals, such as 'engineering paper'."
+ 
+ 	| smallGridAsPoint gridForm gridOrigin fullGrid aColor darkGridOrigin countX countY |
+ 	smallGridAsPoint := smallGrid rounded asPoint.
+ 	fullGrid := smallGridAsPoint * darkerGridEvery.
+ 	gridForm := Form extent: fullGrid depth: Display depth.
+ 	gridOrigin := origin \\ smallGridAsPoint.
+ 	darkGridOrigin := origin \\ fullGrid.
+ 	backColor ifNotNil: [gridForm fillWithColor: backColor].
+ 	darkGridOrigin ifNotNil:[countX:=  darkGridOrigin x. countY:=  darkGridOrigin y] 
+ 	ifNil:[countX:= countY := -1].
+ 
+ 	gridOrigin x to: gridForm width by: smallGridAsPoint x do:
+ 		[:x |
+ 			aColor := (countX \\ darkerGridEvery) = 0 ifTrue: [darkerGridColor] ifFalse: [lineColor].
+ 			gridForm fill: (x at 0 extent: 1 at gridForm height) fillColor: aColor. 
+ 			countX:= countX+ 1.].
+ 	gridOrigin y to: gridForm height by: smallGridAsPoint y do:
+ 		[:y |
+ 			aColor := (countY\\ darkerGridEvery) = 0 ifTrue: [darkerGridColor] ifFalse: [lineColor].
+ 			gridForm fill: (0 at y extent: gridForm width at 1) fillColor: aColor. 
+ 			countY:= countY+ 1.].
+ 	^ InfiniteForm with: gridForm
+ 
+ "
+ 	| aPlayfield |
+ 	aPlayfield := PasteUpMorph authoringPrototype extent: 640 @ 480.
+ 	aPlayfield color: (GraphPaperParameters twoTierGridFormOrigin: (0 at 0) grid: 16 background: Color green muchLighter line: Color blue muchLighter darkerGridEvery: 10 darkerGridColor: Color blue muchDarker).
+ 	aPlayfield openInHand
+ "
+ !

Item was added:
+ ----- Method: GraphPaperParameters>>asInfiniteForm (in category 'form creation') -----
+ asInfiniteForm
+ 	"Answer an InfiniteForm embodying the parameters of the receiver."
+ 
+ 	^ self showDarkerGridAlso
+ 		ifTrue:
+ 			[self class twoTierGridFormOrigin: offset grid: gridEvery  background: backgroundColor line: gridColor darkerGridEvery: darkerGridEvery darkerGridColor: darkerGridColor]
+ 		ifFalse:
+ 			[self class oneTierGridFormOrigin: offset grid: gridEvery  background: backgroundColor line: gridColor]!

Item was added:
+ ----- Method: GraphPaperParameters>>backgroundColor (in category 'accessing') -----
+ backgroundColor
+ 	"Answer the value of backgroundColor"
+ 
+ 	^ backgroundColor!

Item was added:
+ ----- Method: GraphPaperParameters>>backgroundColor: (in category 'accessing') -----
+ backgroundColor: anObject
+ 	"Set the value of backgroundColor."
+ 
+ 	backgroundColor := anObject!

Item was added:
+ ----- Method: GraphPaperParameters>>darkerGridColor (in category 'accessing') -----
+ darkerGridColor
+ 	"Answer the value of darkerGridColor"
+ 
+ 	^ darkerGridColor!

Item was added:
+ ----- Method: GraphPaperParameters>>darkerGridColor: (in category 'accessing') -----
+ darkerGridColor: anObject
+ 	"Set the value of darkerGridColor."
+ 
+ 	darkerGridColor := anObject!

Item was added:
+ ----- Method: GraphPaperParameters>>darkerGridEvery (in category 'accessing') -----
+ darkerGridEvery
+ 	"Answer the value of darkerGridEvery"
+ 
+ 	^ darkerGridEvery!

Item was added:
+ ----- Method: GraphPaperParameters>>darkerGridEvery: (in category 'accessing') -----
+ darkerGridEvery: aNumber
+ 	"Set the value of darkerGridEvery"
+ 
+ 	darkerGridEvery := aNumber rounded!

Item was added:
+ ----- Method: GraphPaperParameters>>fillFrom: (in category 'initialization') -----
+ fillFrom: aGraphPaperMorph
+ 	"Fill the receiver's instance variables from a GraphPaperMorph panel."
+ 
+ 	backgroundColor := aGraphPaperMorph backgroundColor. 
+ 	gridColor := aGraphPaperMorph gridColor.
+ 	gridEvery:= aGraphPaperMorph gridEvery.
+ 	showDarkerGridAlso := aGraphPaperMorph showDarkerGridAlso ifNil: [false].
+ 	darkerGridColor := aGraphPaperMorph darkerGridColor.
+ 	darkerGridEvery := aGraphPaperMorph darkerGridEvery.
+ 	offset := aGraphPaperMorph offset!

Item was added:
+ ----- Method: GraphPaperParameters>>gridColor (in category 'accessing') -----
+ gridColor
+ 	"Answer the value of gridColor"
+ 
+ 	^ gridColor!

Item was added:
+ ----- Method: GraphPaperParameters>>gridColor: (in category 'accessing') -----
+ gridColor: anObject
+ 	"Set the value of gridColor."
+ 
+ 	gridColor := anObject!

Item was added:
+ ----- Method: GraphPaperParameters>>gridEvery (in category 'accessing') -----
+ gridEvery
+ 	"Answer the value of gridEvery"
+ 
+ 	^ gridEvery!

Item was added:
+ ----- Method: GraphPaperParameters>>gridEvery: (in category 'accessing') -----
+ gridEvery: aNumber
+ 	"Set the value of gridEvery"
+ 
+ 	gridEvery := aNumber rounded!

Item was added:
+ ----- Method: GraphPaperParameters>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver and give default values to all the parameters."
+ 
+ 	super initialize.
+ 	backgroundColor := Color green lighter.
+ 	gridColor := Color green darker.
+ 	gridEvery := 16.
+ 	showDarkerGridAlso := true.
+ 	darkerGridColor := Color black.
+ 	darkerGridEvery := 5.
+ 	offset := 0 @ 0!

Item was added:
+ ----- Method: GraphPaperParameters>>offset (in category 'accessing') -----
+ offset
+ 	"Answer the value of offset"
+ 
+ 	^ offset!

Item was added:
+ ----- Method: GraphPaperParameters>>offset: (in category 'accessing') -----
+ offset: anObject
+ 	"Set the value of offset."
+ 
+ 	offset := anObject!

Item was added:
+ ----- Method: GraphPaperParameters>>printOn: (in category 'accessing') -----
+ printOn: aStream
+ 	"Print the receiver on a stream."
+ 
+ 	aStream nextPutAll: ('GraphPaperParameters, offset = ', offset printString, ' gridEvery =', gridEvery printString, ' alsoShowDarkerGrid: ',  showDarkerGridAlso printString).
+ 	showDarkerGridAlso ifTrue:
+ 		[aStream nextPutAll: ' darkerGridEvery: ',  darkerGridEvery printString]!

Item was added:
+ ----- Method: GraphPaperParameters>>showDarkerGridAlso (in category 'accessing') -----
+ showDarkerGridAlso
+ 	"Answer the value of showDarkerGridAlso"
+ 
+ 	^ showDarkerGridAlso!

Item was added:
+ ----- Method: GraphPaperParameters>>showDarkerGridAlso: (in category 'accessing') -----
+ showDarkerGridAlso: anObject
+ 	"Set the value of showDarkerGridAlso"
+ 
+ 	showDarkerGridAlso := anObject!

Item was added:
+ ----- Method: GraphicTile>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') -----
+ parseNodeWith: encoder
+ 
+ 	^ encoder encodePlayer: literal.
+ !

Item was added:
+ ----- Method: GraphicTile>>sexpWith: (in category '*Etoys-Squeakland-code generation') -----
+ sexpWith: dictionary
+ 	^ SExpElement keyword: #literal
+ 		attributes: (SExpAttributes
+ 					with: #type->'Graphic'
+ 					with: #value->(dictionary at: literal) idref).
+ !

Item was changed:
  ----- Method: GraphicTile>>storeCodeOn:indent: (in category 'code generation') -----
  storeCodeOn: aStream indent: tabCount
  	"Write code that will reconstitute the receiver"
  
+ 	aStream nextPutAll: (self referenceWorld uniqueNameForReferenceFor: literal)!
- 	aStream nextPutAll: literal uniqueNameForReference!

Item was added:
+ ----- Method: GraphicalMenu>>target (in category '*Etoys-Squeakland-accessing') -----
+ target
+ 	"Answer the receiver's target."
+ 
+ 	^ target!

Item was added:
+ SystemWindow subclass: #HTTPProxyEditor
+ 	instanceVariableNames: 'serverName port serverNameWidget portWidget serverNameLabelWidget portLabelWidget acceptWidget cancelWidget'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-UI'!
+ 
+ !HTTPProxyEditor commentStamp: 'dgd 10/29/2003 14:29' prior: 0!
+ An editor for the http proxy settings.
+ 
+ To open it evaluate:
+ 
+ 	HTTPProxyEditor open.
+ 
+ or use the World Menu (open... >> http proxy editor).
+ !

Item was added:
+ ----- Method: HTTPProxyEditor class>>activateWindow: (in category 'instance creation') -----
+ activateWindow: aWindow 
+ 	"private - activate the window"
+ 	aWindow
+ 		right: (aWindow right min: World bounds right).
+ 	aWindow
+ 		bottom: (aWindow bottom min: World bounds bottom).
+ 	aWindow
+ 		left: (aWindow left max: World bounds left).
+ 	aWindow
+ 		top: (aWindow top max: World bounds top).
+ 	""
+ 	aWindow comeToFront.
+ 	aWindow flash!

Item was added:
+ ----- Method: HTTPProxyEditor class>>initialize (in category 'class initialization') -----
+ initialize
+ 
+ 	self registerInOpenMenu!

Item was added:
+ ----- Method: HTTPProxyEditor class>>open (in category 'instance creation') -----
+ open
+ 	"open the receiver"
+ World submorphs
+ 		do: [:each | ""
+ 			((each isKindOf: self)
+ )
+ 				ifTrue: [""
+ 					self activateWindow: each.
+ 					^ self]].
+ ""
+ 	^ self new openInWorld!

Item was added:
+ ----- Method: HTTPProxyEditor class>>registerInOpenMenu (in category 'class initialization') -----
+ registerInOpenMenu
+ 	"Register the receiver in the system's open menu"
+ 	TheWorldMenu registerOpenCommand: {'http proxy editor' translated. {HTTPProxyEditor. #open}. 'An editor for the http proxy settings' translated}!

Item was added:
+ ----- Method: HTTPProxyEditor class>>unload (in category 'class initialization') -----
+ unload
+ 	"Called when the class is being removed"
+ 
+ 	TheWorldMenu unregisterOpenCommandWithReceiver: self!

Item was added:
+ ----- Method: HTTPProxyEditor>>accept (in category 'user interface') -----
+ accept
+ 	"the user press the [accept] button"
+ 	serverNameWidget hasUnacceptedEdits
+ 		ifTrue: [serverNameWidget accept].
+ 	portWidget hasUnacceptedEdits
+ 		ifTrue: [portWidget accept].
+ 	""
+ 	self applyChanges.
+ 	""
+ 	self delete!

Item was added:
+ ----- Method: HTTPProxyEditor>>applyChanges (in category 'user interface') -----
+ applyChanges
+ 	"apply the changes on HTTPSocket"
+ 	| finalServerName finalPort |
+ 	finalServerName := serverName asString withBlanksTrimmed.
+ 	[finalPort := port asString withBlanksTrimmed asNumber]
+ 		on: Error
+ 		do: [:ex | finalPort := 0].
+ 	""
+ 	(finalServerName isNil
+ 			or: [finalServerName isEmpty]
+ 			or: [finalPort isZero])
+ 		ifTrue: [""
+ Transcript
+ 		show: ('Stop using Proxy Server.' translated );
+ 		 cr.
+ ""
+ 			HTTPSocket stopUsingProxyServer.
+ 			^ self].
+ 	""
+ 	Transcript
+ 		show: ('Proxy Server Named: ''{1}'' port: {2}.' translated format: {finalServerName. finalPort});
+ 		 cr.
+ 	HTTPSocket useProxyServerNamed: finalServerName port: finalPort!

Item was added:
+ ----- Method: HTTPProxyEditor>>cancel (in category 'user interface') -----
+ cancel
+ 	"the user press the [cancel] button"
+ 	self delete!

Item was added:
+ ----- Method: HTTPProxyEditor>>createButtonLabel:action:help: (in category 'initialization') -----
+ createButtonLabel: aString action: actionSelector help: helpString 
+ 	"private - create a button for the receiver"
+ 	| button |
+ 	button := SimpleButtonMorph new target: self;
+ 				 label: aString;
+ 				 actionSelector: actionSelector;
+ 				 setBalloonText: helpString;
+ 				 borderWidth: 2;
+ 				 useSquareCorners.
+ 	""
+ 	^ button!

Item was added:
+ ----- Method: HTTPProxyEditor>>createLabel: (in category 'initialization') -----
+ createLabel: aString 
+ 	"private - create a label with aString"
+ 	| labelWidget |
+ 	labelWidget := PluggableButtonMorph
+ 				on: self
+ 				getState: nil
+ 				action: nil.
+ 	labelWidget hResizing: #spaceFill;
+ 		 vResizing: #spaceFill;
+ 		 label: aString translated.
+ 	""
+ 	labelWidget onColor: Color transparent offColor: Color transparent.
+ 
+ 	""
+ 	^ labelWidget!

Item was added:
+ ----- Method: HTTPProxyEditor>>createText: (in category 'initialization') -----
+ createText: selector 
+ "private - create a text widget on selector"
+ 	| widget |
+ 	widget := PluggableTextMorph
+ 				on: self
+ 				text: selector
+ 				accept: (selector , ':') asSymbol.
+ 	widget acceptOnCR: true.
+ 	^ widget!

Item was added:
+ ----- Method: HTTPProxyEditor>>initialExtent (in category 'open/close') -----
+ initialExtent
+ "answer the receiver's initialExtent"
+ 	^ 300 @ 180!

Item was added:
+ ----- Method: HTTPProxyEditor>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the receiver"
+ 	super initialize.
+ 	""
+ 	serverName := HTTPSocket httpProxyServer
+ 				ifNil: [''].
+ 	port := HTTPSocket httpProxyPort asString.
+ 	""
+ 	self setLabel: 'HTTP Proxy Editor' translated.
+ 	self
+ 		setWindowColor: (Color
+ 				r: 0.9
+ 				g: 0.8
+ 				b: 1.0).
+ 	""
+ 	self initializeWidgets.
+ 	self updateWidgets.
+ ""
+ self extent: 300 at 180!

Item was added:
+ ----- Method: HTTPProxyEditor>>initializeWidgets (in category 'initialization') -----
+ initializeWidgets
+ 	"initialize the receiver's widgets"
+ 	self
+ 		addMorph: (serverNameLabelWidget := self createLabel: 'Server Name:' translated)
+ 		frame: (0 @ 0 corner: 0.5 @ 0.33).
+ 	self
+ 		addMorph: (serverNameWidget := self createText: #serverName)
+ 		frame: (0.5 @ 0 corner: 1 @ 0.33).
+ 	""
+ 	self
+ 		addMorph: (portLabelWidget := self createLabel: 'Port:' translated)
+ 		frame: (0 @ 0.33 corner: 0.5 @ 0.67).
+ 	self
+ 		addMorph: (portWidget := self createText: #port)
+ 		frame: (0.5 @ 0.33 corner: 1 @ 0.67).
+ 	""
+ 	self
+ 		addMorph: (acceptWidget := self
+ 						createButtonLabel: 'Accept' translated
+ 						action: #accept
+ 						help: 'Accept the proxy settings' translated)
+ 		frame: (0 @ 0.67 corner: 0.5 @ 1).
+ 	self
+ 		addMorph: (cancelWidget := self
+ 						createButtonLabel: 'Cancel' translated
+ 						action: #cancel
+ 						help: 'Cancel the proxy settings' translated)
+ 		frame: (0.5 @ 0.67 corner: 1 @ 1)!

Item was added:
+ ----- Method: HTTPProxyEditor>>paneColor: (in category 'panes') -----
+ paneColor: aColor 
+ 	"the pane color was changed"
+ 	super paneColor: aColor.
+ 	""
+ 	self updateWidgets!

Item was added:
+ ----- Method: HTTPProxyEditor>>port (in category 'accessing') -----
+ port
+ 	"answer the receiver's port"
+ 	^ port!

Item was added:
+ ----- Method: HTTPProxyEditor>>port: (in category 'accessing') -----
+ port: anInteger 
+ "change the receiver's port"
+ 	port := anInteger.
+ 	self changed: #port!

Item was added:
+ ----- Method: HTTPProxyEditor>>serverName (in category 'accessing') -----
+ serverName
+ "answer the receiver's serverName"
+ 	^ serverName!

Item was added:
+ ----- Method: HTTPProxyEditor>>serverName: (in category 'accessing') -----
+ serverName: aString 
+ "change the receiver's serverName"
+ 	serverName := aString.
+ 	self changed: #serverName!

Item was added:
+ ----- Method: HTTPProxyEditor>>updateWidgets (in category 'initialization') -----
+ updateWidgets
+ "update the receiver's widgets"
+ 	acceptWidget isNil
+ 		ifFalse: [""
+ 			acceptWidget color: Color lightGreen;
+ 				 borderWidth: 2;
+ 				 borderColor: #raised].
+ 	cancelWidget isNil
+ 		ifFalse: [""
+ 			cancelWidget color: Color lightRed;
+ 				 borderWidth: 2;
+ 				 borderColor: #raised].
+ 	""
+ 	serverNameLabelWidget isNil
+ 		ifFalse: [""
+ 			serverNameLabelWidget color: self paneColor lighter;
+ 				 borderColor: #raised].
+ 	portLabelWidget isNil
+ 		ifFalse: [""
+ 			portLabelWidget color: self paneColor lighter;
+ 				 borderColor: #raised]!

Item was added:
+ ----- Method: HTTPSocket class>>argStringUnencoded: (in category '*Etoys-Squeakland-utilities') -----
+ argStringUnencoded: args
+ 	"Return the args in a long string, as encoded in a url"
+ 
+ 	| argsString first |
+ 	args isString ifTrue: ["sent in as a string, not a dictionary"
+ 		^ (args first = $? ifTrue: [''] ifFalse: ['?']), args].
+ 	argsString _ WriteStream on: String new.
+ 	argsString nextPut: $?.
+ 	first _ true.
+ 	args associationsDo: [ :assoc |
+ 		assoc value do: [ :value |
+ 			first ifTrue: [ first _ false ] ifFalse: [ argsString nextPut: $& ].
+ 			argsString nextPutAll: assoc key.
+ 			argsString nextPut: $=.
+ 			argsString nextPutAll: value. ] ].
+ 	^ argsString contents
+ !

Item was added:
+ ----- Method: HTTPSocket class>>retry:asking:ifGiveUp: (in category '*Etoys-Squeakland-utilities') -----
+ retry: tryBlock asking: troubleString ifGiveUp: abortActionBlock
+ 	"Execute the given block. If it evaluates to true, return true. If it evaluates to false, prompt the user with the given string to see if he wants to try again. If not, evaluate the abortActionBlock and return false."
+ 
+ 	| response  |
+ 	[tryBlock value] whileFalse: [
+ 		| sema |
+ 		sema _ Semaphore new.
+ 		WorldState addDeferredUIMessage: [
+ 			response _ (PopUpMenu labels: 'Retry\Give Up' translated withCRs)
+ 				startUpWithCaption: troubleString.
+ 			sema signal.
+ 		].
+ 		sema wait.
+ 		response = 2 ifTrue: [abortActionBlock value. ^ false]].
+ 	^ true
+ !

Item was added:
+ ----- Method: HaloMorph>>addSmallHandle:on:send:to: (in category '*Etoys-Squeakland-private') -----
+ addSmallHandle: handleSpec on: eventName send: selector to: recipient
+ 	"Add a handle within the halo box as per the haloSpec, and set it up to respond to the given event by sending the given selector to the given recipient.  Return the handle.  This is the 5/17/04 version of HaloMorph>>addHandle:on:send:to:"
+ 
+ 	| handle aPoint iconName colorToUse |
+ 	aPoint _ self positionIn: haloBox horizontalPlacement: handleSpec horizontalPlacement verticalPlacement: handleSpec verticalPlacement.
+ 	handle _ EllipseMorph
+ 		newBounds: (Rectangle center: aPoint extent: self handleSize asPoint)
+ 		color: (colorToUse _ Color colorFrom: handleSpec color).
+ 	handle borderColor: colorToUse muchDarker.
+ 	self addMorph: handle.
+ 	(iconName _ handleSpec iconSymbol) ifNotNil:
+ 		[ | form |
+ 		form _ ScriptingSystem formAtKey: iconName.
+ 		form ifNotNil:
+ 			[handle addMorphCentered: (ImageMorph new
+ 				image: form; 
+ 				color: colorToUse makeForegroundColor;
+ 				lock)]].
+ 	handle on: #mouseUp send: #endInteraction to: self.
+ 	handle on: eventName send: selector to: recipient.
+ 	self isMagicHalo ifTrue:[
+ 		handle on: #mouseEnter send: #handleEntered to: self.
+ 		handle on: #mouseLeave send: #handleLeft to: self].
+ 	handle setBalloonText: (target balloonHelpTextForHandle: handle) translated.
+ 	^ handle
+ !

Item was added:
+ ----- Method: HaloMorph>>dragTarget: (in category '*Etoys-Squeakland-events') -----
+ dragTarget: event
+ 	"Begin dragging the target"
+ 
+ 	| thePoint |
+ 	event controlKeyPressed ifTrue: [^self growTarget: event].
+ 	growingOrRotating := false.
+ 	innerTarget aboutToBeBrownDragged.
+ 	self setProperty: #conclusionSelector toValue: #brownDragConcluded.
+ 	thePoint _ target point: event position - positionOffset from: owner.
+ 	target setConstrainedPosition: thePoint hangOut: true.
+ 	event hand newMouseFocus: self!

Item was added:
+ ----- Method: HaloMorph>>growTarget: (in category '*Etoys-Squeakland-events') -----
+ growTarget: event
+ 	"Begin resizing the target"
+ 	growingOrRotating := true.
+ 	positionOffset := event position.
+ 	originalExtent := target extent.
+ 	self removeAllHandlesBut: nil.
+ 	event hand newMouseFocus: self.
+ 	event hand addMouseListener: self. "add handles back on mouse-up"!

Item was added:
+ ----- Method: HaloMorph>>highlight:handleName:state: (in category '*Etoys-Squeakland-private') -----
+ highlight: handle handleName: handleName state: state 
+ 	"Change color of handles. Need refactoring later..."
+ 	| form highlightName |
+ 	handle class == ThreePhaseButtonMorph
+ 		ifTrue: [form := ScriptingSystem formPressedAtKey: handleName.
+ 			state == #on
+ 				ifTrue: [highlightName := (handleName , 'Highlighted') asSymbol.
+ 					form := ScriptingSystem formAtKey: highlightName.
+ 					form
+ 						ifNil: [ScriptingSystem saveForm: (form := (ScriptingSystem formAtKey: handleName)
+ 											blendColor: (Color white alpha: 0.5)) colorReduced atKey: highlightName]].
+ 			handle offImage: form.
+ 			handle pressedImage: form.
+ 			^ self].
+ 	handleName == #'Halo-Rot'
+ 		ifTrue: [state == #on
+ 				ifTrue: [handle color: Color lightBlue]
+ 				ifFalse: [handle color: Color blue].
+ 			handle
+ 				submorphsDo: [:m | m color: handle color makeForegroundColor]].
+ 	handleName == #'Halo-Scale'
+ 		ifTrue: [state == #on
+ 				ifTrue: [handle color: Color yellow]
+ 				ifFalse: [handle color: Color orange]]!

Item was added:
+ PreferenceView subclass: #HaloThemePreferenceView
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Support'!
+ 
+ !HaloThemePreferenceView commentStamp: '<historical>' prior: 0!
+ I am responsible for building the view for the preference that choose the halo theme!

Item was added:
+ ----- Method: HaloThemePreferenceView class>>handlesPanel: (in category 'view registry') -----
+ handlesPanel: aPreferencePanel
+ 	^aPreferencePanel isKindOf: PreferencesPanel!

Item was added:
+ ----- Method: HaloThemePreferenceView class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"adding the halo theme preference to Preferences and registering myself as its view"
+ 	PreferenceViewRegistry ofHaloThemePreferences register: self.
+ 	Preferences 
+ 		addPreference: #haloTheme 
+ 		categories: {#halos} 
+ 		default: #iconicHaloSpecifications
+ 		balloonHelp: ''
+ 		projectLocal: false
+ 		changeInformee: nil
+ 		changeSelector: nil
+ 		viewRegistry: PreferenceViewRegistry ofHaloThemePreferences.!

Item was added:
+ ----- Method: HaloThemePreferenceView class>>unload (in category 'class initialization') -----
+ unload
+ 	PreferenceViewRegistry ofHaloThemePreferences unregister: self.!

Item was added:
+ ----- Method: HaloThemePreferenceView>>haloThemeRadioButtons (in category 'user interface') -----
+ haloThemeRadioButtons
+ 	"Answer a column of butons representing the choices of halo theme"
+ 
+ 	| buttonColumn aRow aRadioButton aStringMorph |
+ 	buttonColumn := AlignmentMorph newColumn beTransparent.
+ 	#('iconic' 'classic' 'simple' 'custom') translatedNoop.
+ 	#(	(iconicHaloSpecifications iconic iconicHalosInForce	'circular halos with icons inside')
+ 		(classicHaloSpecs	classic	classicHalosInForce		'plain circular halos')
+ 		(simpleFullHaloSpecifications		simple	simpleHalosInForce	'fewer, larger halos')
+ 		(customHaloSpecs	custom	customHalosInForce		'customizable halos')) translatedNoop do:
+ 
+ 		[:quad |
+ 			aRow := AlignmentMorph newRow beTransparent.
+ 			aRow addMorph: (aRadioButton := UpdatingThreePhaseButtonMorph radioButton).
+ 			aRadioButton target: Preferences.
+ 			aRadioButton setBalloonText: quad fourth translated.
+ 			aRadioButton actionSelector: #installHaloTheme:.
+ 			aRadioButton getSelector: quad third.
+ 			aRadioButton arguments: (Array with: quad first).
+ 			aRow addTransparentSpacerOfSize: (4 @ 0).
+ 			aRow addMorphBack: (aStringMorph := StringMorph contents: quad second asString translated).
+ 			aStringMorph setBalloonText: quad fourth translated.
+ 			buttonColumn addMorphBack: aRow].
+ 	^ buttonColumn
+ 
+ 	"(Preferences preferenceAt: #haloTheme) view tearOffButton"!

Item was added:
+ ----- Method: HaloThemePreferenceView>>representativeButtonWithColor:inPanel: (in category 'user interface') -----
+ representativeButtonWithColor: aColor inPanel: aPreferencesPanel
+ 	| outerButton editButton |
+ 	editButton := SimpleButtonMorph new 
+ 					target: Preferences; 
+ 					color: Color transparent; 
+ 					actionSelector: #editCustomHalos; 
+ 					label: 'Edit custom halos' translated;
+ 					setBalloonText: 'Click here to edit the method that defines the custom halos' translated.
+ 	
+ 	outerButton := AlignmentMorph newColumn.
+ 	outerButton
+ 		color:  (aColor ifNil: [Color r: 0.645 g: 1.0 b: 1.0]);
+ 		hResizing: (aPreferencesPanel ifNil: [#shrinkWrap] ifNotNil: [#spaceFill]);
+ 		vResizing: #shrinkWrap;	
+ 		addTransparentSpacerOfSize: (0 at 4);
+ 		addMorphBack: self haloThemeRadioButtons;
+ 		addTransparentSpacerOfSize: (0 at 4);
+ 		addMorphBack: editButton.
+ 		
+ 	^outerButton.
+ 	
+ 	"(Preferences preferenceAt: #haloTheme) view tearOffButton"	!

Item was added:
+ ----- Method: HandMorph class>>cursorDesignChanged (in category '*Etoys-Squeakland-utilities') -----
+ cursorDesignChanged
+ 
+ 	Cursor startUp.
+ 	self initializeCursorForm.
+ !

Item was added:
+ ----- Method: HandMorph class>>initializeCursorForm (in category '*Etoys-Squeakland-initialization') -----
+ initializeCursorForm
+ 
+ 	NormalCursor _ CursorWithMask normal asCursorForm.
+ !

Item was added:
+ ----- Method: HandMorph>>copyMorph (in category '*Etoys-Squeakland-paste buffer') -----
+ copyMorph
+ 	| target |
+ 	target := self halo
+ 				ifNotNil: [self halo target].
+ 	target
+ 		ifNil: [target := self submorphs isEmpty
+ 						ifFalse: [self submorphs first]].
+ 	target
+ 		ifNil: [^ self].
+ 	self copyToPasteBuffer: target!

Item was added:
+ ----- Method: HandMorph>>dndOutStart: (in category '*Etoys-Squeakland-external dragging') -----
+ dndOutStart: aMorph 
+ 	| types nullSeparated |
+ 	"Drag and Drop session is initialized in this method."
+ 	types := aMorph mimeTypes.
+ 	nullSeparated := String
+ 				streamContents: [:str | types
+ 						do: [:type | str nextPutAll: type]
+ 						separatedBy: [str
+ 								nextPut: (Character value: 0)]].
+ 	self primitiveDndOutStart: nullSeparated!

Item was added:
+ ----- Method: HandMorph>>eventRecorders (in category '*Etoys-Squeakland-listeners') -----
+ eventRecorders
+ 	"Answer all currently active event recorders."
+ 	| listeners |
+ 	listeners := self eventListeners ifNil: [^#()].
+ 	^listeners select: [:any| any isKindOf: EventRecorderMorph]!

Item was added:
+ ----- Method: HandMorph>>forceToBeVisible (in category '*Etoys-Squeakland-utilities') -----
+ forceToBeVisible
+ 	"Use brute force to circumvent the needsToBeDrawn check of HandMorph's #visible: method."
+ 
+ 	super visible: true.
+ 	self showTemporaryCursor: nil
+ 
+ "
+ ActiveHand forceToBeVisible.
+ "!

Item was added:
+ ----- Method: HandMorph>>handleDndOut (in category '*Etoys-Squeakland-external dragging') -----
+ handleDndOut
+ 	| morph stream writer type |
+ 	"Send dragging object data to requester window."
+ 	morph := self
+ 				valueOfProperty: #dndOutMorph
+ 				ifAbsent: [^ self].
+ 	type := self primitiveDndOutAcceptedType.
+ 	type = 'image/png'
+ 		ifTrue: [stream := ByteArray new writeStream.
+ 			writer := PNGReadWriter on: stream binary.
+ 			writer nextPutImage: morph imageForm.
+ 			writer close.
+ 			stream contents.
+ 			^ self primitiveDndOutSend: stream contents].
+ 	type = 'UTF8_STRING'
+ 		ifTrue: [^ self
+ 				primitiveDndOutSend: (morph getCharacters convertToEncoding: 'utf8')]!

Item was added:
+ ----- Method: HandMorph>>handleDndOutMorph: (in category '*Etoys-Squeakland-external dragging') -----
+ handleDndOutMorph: aMorph 
+ 	"Remember target morph for dnd out"
+ 	self setProperty: #dndOutMorph toValue: aMorph!

Item was added:
+ ----- Method: HandMorph>>modal (in category '*Etoys-Squeakland-accessing') -----
+ modal
+ 
+ 	^ modal
+ !

Item was added:
+ ----- Method: HandMorph>>modal: (in category '*Etoys-Squeakland-accessing') -----
+ modal: aBoolean
+ 
+ 	modal _ aBoolean.
+ !

Item was added:
+ ----- Method: HandMorph>>primitiveDndOutAcceptedType (in category '*Etoys-Squeakland-external dragging') -----
+ primitiveDndOutAcceptedType 
+ 	<primitive: 'primitiveDndOutAcceptedType' module:'DropPlugin'>
+ !

Item was added:
+ ----- Method: HandMorph>>primitiveDndOutSend: (in category '*Etoys-Squeakland-external dragging') -----
+ primitiveDndOutSend: aByteArray 
+ 	<primitive: 'primitiveDndOutSend' module:'DropPlugin'>
+ !

Item was added:
+ ----- Method: HandMorph>>primitiveDndOutStart: (in category '*Etoys-Squeakland-external dragging') -----
+ primitiveDndOutStart: aByteArray
+ 	<primitive: 'primitiveDndOutStart' module:'DropPlugin'>
+ !

Item was added:
+ ----- Method: HandMorph>>simulateMorphDropAt: (in category '*Etoys-Squeakland-grabbing/dropping') -----
+ simulateMorphDropAt: aPosition
+ 	"Simulate a drop of the morph I'm carrying."
+ 
+ 	| event dropped aMorph |
+ 	aMorph := submorphs at:  1 ifAbsent: [^ self].
+ 	self privateRemove: aMorph.
+ 	aMorph privateOwner: self.
+ 
+ 	dropped _ aMorph.
+ 	(dropped hasProperty: #addedFlexAtGrab) 
+ 		ifTrue:[dropped _ aMorph removeFlexShell].
+ 	event _ DropEvent new setPosition: aPosition contents: dropped hand: self.
+ 	self sendEvent: event focus: nil.
+ 	event wasHandled ifFalse:[aMorph rejectDropMorphEvent: event].
+ 	aMorph owner == self ifTrue: [aMorph delete]!

Item was added:
+ ----- Method: HandMorphForReplay>>recorder (in category '*Etoys-Squeakland-initialization') -----
+ recorder
+ 	"Answer the EventRecorderMorph affiliated with the receiver."
+ 
+ 	^ recorder!

Item was added:
+ ----- Method: HandMorphForReplay>>suspended (in category '*Etoys-Squeakland-accessing') -----
+ suspended
+ 	"Answer the value of suspended"
+ 
+ 	^ suspended!

Item was added:
+ ----- Method: HandMorphForReplay>>suspended: (in category '*Etoys-Squeakland-accessing') -----
+ suspended: anObject
+ 	"Set the value of suspended"
+ 
+ 	suspended _ anObject!

Item was added:
+ RectangleMorph subclass: #HeadingMorph
+ 	instanceVariableNames: 'degrees magnitude'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Demo'!

Item was added:
+ ----- Method: HeadingMorph>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ "answer the default border width for the receiver"
+ 	^ 1!

Item was added:
+ ----- Method: HeadingMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ "answer the default color/fill style for the receiver"
+ 	^ Color
+ 		r: 0.6
+ 		g: 1.0
+ 		b: 1.0!

Item was added:
+ ----- Method: HeadingMorph>>degrees (in category 'accessing') -----
+ degrees
+ 
+ 	^ (degrees + 90.0) \\ 360.0!

Item was added:
+ ----- Method: HeadingMorph>>degrees: (in category 'accessing') -----
+ degrees: aNumber
+ 
+ 	degrees _ (aNumber asFloat + 270.0) \\ 360.0.!

Item was added:
+ ----- Method: HeadingMorph>>drawArrowFrom:to:width:color:on: (in category 'drawing') -----
+ drawArrowFrom: p1 to: p2 width: w color: aColor on: aCanvas
+ 
+ 	| d p |
+ 	d _ (p1 - p2) theta radiansToDegrees.
+ 	aCanvas line: p1 to: p2 width: w color: aColor.
+ 	p _ p2 + (Point r: 5 degrees: d - 50).
+ 	aCanvas line: p to: p2 width: w color: aColor.
+ 	p _ p2 + (Point r: 5 degrees: d + 50).
+ 	aCanvas line: p to: p2 width: w color: aColor.
+ !

Item was added:
+ ----- Method: HeadingMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 
+ 	| x y r center box |
+ 	super drawOn: aCanvas.
+ 	box _ self innerBounds.
+ 	1 to: 9 do: [:i |
+ 		x _ box left + ((box width * i) // 10).
+ 		aCanvas line: (x at box top) to: (x@(box bottom - 1)) color: 
+ Color black.
+ 		y _ box top + ((box height * i) // 10).
+ 		aCanvas line: (box left at y) to: ((box right - 1)@y) color: 
+ Color black].
+ 
+ 	r _ ((box width asFloat * magnitude asFloat) / 2.0) - 1.0.
+ 	center _ box center.
+ 	self drawArrowFrom: center - (1 at 1)
+ 		to: center + ((r * degrees degreesToRadians cos)@0) - (1 at 1)
+ 		width: 3
+ 		color: (Color red)
+ 		on: aCanvas.
+ 	self drawArrowFrom: center - (1 at 1)
+ 		to: center + (0@(r * degrees degreesToRadians sin)) - (1 at 1)
+ 		width: 3
+ 		color: (Color red)
+ 		on: aCanvas.
+ 	self drawArrowFrom: center - (1 at 1)
+ 		to: center + (Point r: r degrees: degrees) - (1 at 1)
+ 		width: 3
+ 		color: Color black
+ 		on: aCanvas.
+ !

Item was added:
+ ----- Method: HeadingMorph>>extent: (in category 'geometry') -----
+ extent: aPoint
+ 	"Contrain extent to be square."
+ 
+ 	| d |
+ 	d _ aPoint x min: aPoint y.
+ 	super extent: d at d.
+ !

Item was added:
+ ----- Method: HeadingMorph>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: evt
+ 
+ 	^ true
+ !

Item was added:
+ ----- Method: HeadingMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	degrees _ 90.0.
+ 	magnitude _ 1.0.
+ 	
+ 	self extent: 160 @ 160!

Item was added:
+ ----- Method: HeadingMorph>>magnitude (in category 'accessing') -----
+ magnitude
+ 
+ 	^ magnitude!

Item was added:
+ ----- Method: HeadingMorph>>magnitude: (in category 'accessing') -----
+ magnitude: aNumber
+ 
+ 	magnitude _ (aNumber asFloat max: 0.0) min: 1.0.!

Item was added:
+ ----- Method: HeadingMorph>>mouseDown: (in category 'events') -----
+ mouseDown: evt
+ 
+ 	| v |
+ 	self changed.
+ 	v _ evt cursorPoint - bounds center.
+ 	degrees _ v theta radiansToDegrees.
+ 	magnitude _ (v r asFloat / (bounds width asFloat / 2.0)) min: 1.0.
+ !

Item was added:
+ ----- Method: HeadingMorph>>mouseMove: (in category 'events') -----
+ mouseMove: evt
+ 
+ 	self mouseDown: evt!

Item was added:
+ AlignmentMorph subclass: #HelpFlap
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Help'!

Item was added:
+ ----- Method: HelpFlap>>spanContainerVertically: (in category 'geometry') -----
+ spanContainerVertically: aSize
+ 	"Span the receiver's container verticallly, perhaps taking sugar nav bar into account."
+ 
+ 	SugarNavigatorBar showSugarNavigator ifFalse: [^ super spanContainerVertically: aSize].
+ 	self height: (aSize - SugarNavigatorBar someInstance height)!

Item was added:
+ FormInput subclass: #HiddenInput
+ 	instanceVariableNames: 'name value'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Forms'!
+ 
+ !HiddenInput commentStamp: '<historical>' prior: 0!
+ a "hidden" input.  It never actually appear on a formatted page, and the user can't change the input value.!

Item was added:
+ ----- Method: HiddenInput class>>name:value: (in category 'instance creation') -----
+ name: name0  value: value
+ 	^self new name: name0  value: value!

Item was added:
+ ----- Method: HiddenInput>>name (in category 'input handling') -----
+ name
+ 	^name!

Item was added:
+ ----- Method: HiddenInput>>name:value: (in category 'private-initialization') -----
+ name: name0  value: value0
+ 	name _ name0.	
+ 	value _ value0.!

Item was added:
+ ----- Method: HiddenInput>>value (in category 'input handling') -----
+ value
+ 	^value!

Item was added:
+ ----- Method: HierarchicalUrl>>password: (in category '*Etoys-Squeakland-access') -----
+ password: aString
+ 	^ password := aString!

Item was added:
+ ----- Method: HierarchicalUrl>>username: (in category '*Etoys-Squeakland-access') -----
+ username: aString
+ 	^username := aString!

Item was added:
+ Morph subclass: #HighlightMorph
+ 	instanceVariableNames: 'target lastHash stepTime'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Debugger'!

Item was added:
+ ----- Method: HighlightMorph class>>on: (in category 'as yet unclassified') -----
+ on: targetMorph
+ 	^ self basicNew initializeWith: targetMorph!

Item was added:
+ ----- Method: HighlightMorph>>containsPoint: (in category 'testing') -----
+ containsPoint: aPoint
+ ^ (self bounds containsPoint: aPoint) and:
+ 	  [(self imageForm isTransparentAt: aPoint - bounds origin) not]!

Item was added:
+ ----- Method: HighlightMorph>>incrementStepTime (in category 'stepping') -----
+ incrementStepTime
+ 	stepTime := (stepTime + 1) min: self maximumStepTime!

Item was added:
+ ----- Method: HighlightMorph>>initialize (in category 'initialize-release') -----
+ initialize
+ 	super initialize.
+ 	stepTime := self minimumStepTime.
+ 	self color: Color transparent;
+ 		borderWidth: 2;
+ 		borderColor: Color red muchDarker muchDarker!

Item was added:
+ ----- Method: HighlightMorph>>initializeWith: (in category 'initialize-release') -----
+ initializeWith: targetMorph
+ 	target := targetMorph.
+ 	self initialize!

Item was added:
+ ----- Method: HighlightMorph>>maximumStepTime (in category 'stepping') -----
+ maximumStepTime
+ 	^500!

Item was added:
+ ----- Method: HighlightMorph>>minimumStepTime (in category 'stepping') -----
+ minimumStepTime
+ 	^20!

Item was added:
+ ----- Method: HighlightMorph>>step (in category 'stepping') -----
+ step
+ 	(target isNil or: [lastHash = (lastHash := target boundsSignatureHash)])
+ 		ifTrue: [self incrementStepTime]
+ 		ifFalse: [stepTime := self minimumStepTime].
+ 
+ 	target notNil ifTrue: [
+ 		target isInWorld ifFalse: [^self delete].
+ 		self bounds: target bounds]!

Item was added:
+ ----- Method: HighlightMorph>>stepTime (in category 'stepping') -----
+ stepTime
+ 	^ stepTime!

Item was added:
+ NumberLineMorph subclass: #HorizontalNumberLineMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-MorphicExtras-Charts'!
+ 
+ !HorizontalNumberLineMorph commentStamp: 'sw 2/15/2012 21:01' prior: 0!
+ A number line horizontally oriented.!

Item was added:
+ ----- Method: HorizontalNumberLineMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	"Answer a description for use in parts bins"
+ 
+ 	^ self
+ 		partName: 'H number line' translatedNoop
+ 		categories: {'Graphing' translatedNoop}
+ 		documentation: 'A horizontal number line.  One possible use is as an x-axis in a graph.' translatedNoop!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>addLegendsAndMarks (in category 'initialization') -----
+ addLegendsAndMarks
+ 	"Add legends and tick-marks."
+ 
+ 	| index offset current n legendCenter markCenter aMark aLegend |
+ 	minValue ifNil: ["too early" ^ self].
+ 
+ 	index := 0.
+ 	offset := self offset.
+ 	(submorphs copyWithout: axis) do: [:m | m delete].
+ 	current := self left + offset.
+ 	[current < (self right - offset)] whileTrue:
+ 		[n := minValue + index.
+ 		(n isDivisibleBy: unitsPerMark) ifTrue:
+ 			[markCenter := current @ (self top + (self marksHeight / 2)).
+ 			aMark := self newMark.
+ 			self addMorph: aMark.
+ 			aMark center: markCenter; color: self color.
+ 
+ 			(n isDivisibleBy: self marksPerLegend) ifTrue:
+ 				[(n ~= 0 or: [showZero]) ifTrue:
+ 					[legendCenter := current @ (self top + self marksHeight + (self legendsHeight / 2)) + (0 @ 2).
+ 					aLegend := StringMorph contents: n asString.
+ 					self addMorph: aLegend.
+ 					aLegend center: legendCenter; color: self color]]].
+ 			current := current + pixelsPerUnit.
+ 			index := index + 1].
+ 	^ index!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>asValidExtent: (in category 'initialization') -----
+ asValidExtent: newExtent 
+ 	^ (newExtent x max: 100)
+ 		@ (self marksHeight + self legendsHeight)!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>centerOfAxisVertex: (in category 'initialization') -----
+ centerOfAxisVertex: n 
+ 	n = 1
+ 		ifTrue: [^ self left @ (self top + self marksHeight)].
+ 	n = 2
+ 		ifTrue: [^ self right @ (self top + self marksHeight)].
+ 	^ self error: 'Invalid vertex'!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>fitPlayfield (in category 'initialization') -----
+ fitPlayfield
+ 	"Currently unused and not yet really correct... the idea is to have a command whose result will be that the number line will expand or contract as needed such that the line exactly fills the horizontal space of its containing playfield.   A similar item would be wanted for vertical axes as well..."
+ 
+ 	| aPlayfield |
+ 	aPlayfield := self referencePlayfield.
+ 	"find a value that is currently on screen."
+ 	self minValue: (self horizontalCoordinateForX: 0) ceiling.
+ 	self maxValue: (self horizontalCoordinateForX: aPlayfield right) truncated!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>horizontalCoordinateForX: (in category 'coordinates') -----
+ horizontalCoordinateForX: xPixelValue
+ 	"Answer the horizontal coordinate, in the metric embodied in the number line at hand, corresponding to a given x pixel-coordinate."
+ 
+ 	| start origin |
+ 	start := self left + self offset.
+ 	origin := start + (0 - minValue * pixelsPerUnit).
+ 	^ xPixelValue - origin / pixelsPerUnit!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>horizontalCoordinateOf: (in category 'coordinates') -----
+ horizontalCoordinateOf: anObject
+ 	"Answer the horizontal coordinate of the center of a given object in the number-line's metric space."
+ 
+ 	anObject ifNil:  [^ 0].
+ 	^ self horizontalCoordinateForX: anObject center x!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver."
+ 
+ 	super initialize.
+ 	self extent: 600 @ self allowance!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>maxValue (in category 'accessing') -----
+ maxValue
+ 	"Answer the maximum value represented at the positive end of the receiver."
+ 
+ 	^ minValue + (self width - self allowance / pixelsPerUnit) rounded!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>maxValue: (in category 'accessing') -----
+ maxValue: aNumber
+ 	"Establish the maximum value represented.  This is done by extending or contracting the receiver."
+ 
+ 	self width: (aNumber - minValue * pixelsPerUnit) rounded + self allowance + ((self widthOfString: aNumber asString)
+ 				/ 2)!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>minValue: (in category 'accessing') -----
+ minValue: aNumber
+ 	"Establish the value corresponding to the lowest end of the line."
+ 
+ 	| diff |
+ 	diff := self minValue - aNumber.
+ 	self bounds: (self bounds withLeft: self bounds left - (self pixelsPerUnit * diff)).
+ 	super minValue: aNumber!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>newMark (in category 'initialization') -----
+ newMark
+ 	^ Morph new extent: 2 @ self marksHeight!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>registerGraphCoordinate:atPlayfieldLocation: (in category 'initialization') -----
+ registerGraphCoordinate: aGraphCoordinate atPlayfieldLocation: desiredPlayfieldCoordinate
+ 	"Fine-tuning for perfect registry."
+ 
+ 	| itsCurrentOnPlayfield delta |
+ 	itsCurrentOnPlayfield := ((aGraphCoordinate - minValue) * pixelsPerUnit) + self left + self offset. "relative to playfield's left edge"
+ 	delta := (desiredPlayfieldCoordinate - itsCurrentOnPlayfield) + owner left.
+ 	self left: self left + delta.
+ 	self update!

Item was added:
+ ----- Method: HorizontalNumberLineMorph>>setXOnGraphFor:to: (in category 'coordinates') -----
+ setXOnGraphFor: aMorph to: aNumber
+ 	"Position a morph horizontally such that its xOnGraph, given the current horizontal axis in play, is as indicated."
+ 
+ 	| start |
+ 	start := self left + self offset.
+ 	aMorph center: start + (aNumber - minValue * pixelsPerUnit) @ aMorph center y!

Item was added:
+ HtmlSpecialEntity subclass: #HtmlAnchor
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlAnchor>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	| href name |
+ 
+ 	name _ self getAttribute: 'name'.
+ 	name ifNotNil: [
+ 		formatter noteAnchorStart: name ].
+ 
+ 	href _ self getAttribute: 'href'.
+ 
+ 	href isNil
+ 		ifTrue: [ super addToFormatter: formatter ]
+ 		ifFalse: [ 	
+ 			formatter startLink: href.
+ 			super addToFormatter: formatter.
+ 			formatter endLink: href. ].
+ !

Item was added:
+ ----- Method: HtmlAnchor>>mayContain: (in category 'testing') -----
+ mayContain: anEntity 
+ 	(self attributes includesKey: 'href') ifFalse: [
+ 		"if we have no href, then we can contain nothing"
+ 		^false ].
+ 
+ 	^ anEntity isTextualEntity!

Item was added:
+ ----- Method: HtmlAnchor>>tagName (in category 'testing') -----
+ tagName
+ 	^'a'!

Item was added:
+ HtmlEntity subclass: #HtmlArea
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlArea>>buildMorph (in category 'formatting') -----
+ buildMorph
+ 	"construct a hot-spot morph"
+ 	| coords vertices radiusX radiusY |
+ 	coords _ (self coords findTokens: ', ') collect: [:elem | elem asNumber asInteger].
+ 	self shape isEmptyOrNil
+ 		ifTrue: [^nil].
+ 
+ 	(self shape asLowercase beginsWith: 'poly')
+ 		ifTrue: [coords size even ifFalse: [^nil].
+ 			vertices _ OrderedCollection new.
+ 			coords pairsDo: [:x :y |
+ 				vertices add: x @ y].
+ 			^(PolygonMorph vertices: vertices color: Color transparent
+ 				borderWidth: 1 borderColor: Color transparent) quickFill: false; makeClosed].
+ 
+ 	(coords size > 4 or: [coords size < 3])
+ 		ifTrue: [^nil].
+ 
+ 	self shape asLowercase = 'circle'
+ 		ifTrue: [radiusX _ coords third.
+ 			radiusY _ coords last.
+ 			^(EllipseMorph newBounds:
+ 				(((coords first - radiusX) @ (coords second - radiusY))
+ 				extent:
+ 				((2 * radiusX) @ (2 * radiusY)))
+ 			color: Color transparent) borderColor: Color transparent].
+ 
+ 	coords size = 4
+ 		ifFalse: [^nil].
+ 
+ 	(self shape asLowercase beginsWith: 'rect')
+ 		ifTrue: [^(RectangleMorph newBounds:
+ 				(Rectangle origin: (coords first @ coords second)
+ 				corner: (coords third @ coords last))
+ 			color: Color transparent) borderColor: Color transparent].
+ 
+ 	^nil!

Item was added:
+ ----- Method: HtmlArea>>coords (in category 'accessing') -----
+ coords
+ 	^self getAttribute: 'coords'!

Item was added:
+ ----- Method: HtmlArea>>href (in category 'accessing') -----
+ href
+ 	^self getAttribute: 'href'!

Item was added:
+ ----- Method: HtmlArea>>isArea (in category 'testing') -----
+ isArea
+ 	^true!

Item was added:
+ ----- Method: HtmlArea>>linkMorphForMap:andBrowser: (in category 'formatting') -----
+ linkMorphForMap: map andBrowser: browser
+ 	| m |
+ 	(m _ self buildMorph) ifNil: [^nil].
+ 	m color: (Color random alpha: 0.1). "hack to ensure the morph is clickable"
+ 	m
+ 		on: #mouseUp
+ 		send: #mouseUpBrowserAndUrl:event:linkMorph:
+ 		to: map
+ 		withValue: {browser. self href}.
+ 	^m!

Item was added:
+ ----- Method: HtmlArea>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^false!

Item was added:
+ ----- Method: HtmlArea>>shape (in category 'accessing') -----
+ shape
+ 	^self getAttribute: 'shape'!

Item was added:
+ ----- Method: HtmlArea>>tagName (in category 'testing') -----
+ tagName
+ 	^'area'!

Item was added:
+ Dictionary subclass: #HtmlAttributes
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser'!

Item was added:
+ ----- Method: HtmlAttributes>>printHtmlOn: (in category 'printing') -----
+ printHtmlOn: aStream
+ 	self associationsDo: 
+ 		[:element | 
+ 		aStream 
+ 			space;
+ 			nextPutAll: element key asUppercase.
+ 		element value ifNotNil: [  
+ 				aStream nextPut: $=.
+ 				aStream print: element value withoutQuoting]. ]!

Item was added:
+ HtmlFontChangeEntity subclass: #HtmlBiggerFontEntity
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlBiggerFontEntity commentStamp: '<historical>' prior: 0!
+ an entity which supposedly increases the font size of its constituents!

Item was added:
+ HtmlEntity subclass: #HtmlBlockEntity
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlBlockEntity commentStamp: '<historical>' prior: 0!
+ a moderately high level entitiy.  This includes P, FORM, and UL, among others!

Item was added:
+ ----- Method: HtmlBlockEntity>>isBlockEntity (in category 'testing') -----
+ isBlockEntity
+ 	^true!

Item was added:
+ HtmlBlockEntity subclass: #HtmlBlockQuote
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlBlockQuote>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter ensureNewlines: 2.
+ 	formatter increaseIndent.
+ 	super addToFormatter: formatter.
+ 	formatter decreaseIndent.
+ 	formatter ensureNewlines: 2.!

Item was added:
+ ----- Method: HtmlBlockQuote>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isTextualEntity!

Item was added:
+ ----- Method: HtmlBlockQuote>>tagName (in category 'testing') -----
+ tagName
+ 	^'blockquote'!

Item was added:
+ HtmlEntity subclass: #HtmlBody
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlBody>>background (in category 'attributes') -----
+ background
+ 	^self getAttribute: 'background' default: nil!

Item was added:
+ ----- Method: HtmlBody>>bgcolor (in category 'attributes') -----
+ bgcolor
+ 	^self getAttribute: 'bgcolor' default: 'white'!

Item was added:
+ ----- Method: HtmlBody>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	"Body's can contain anything, so that even if we screw up the parsing, all the text will end up actually being included"
+ 	^true!

Item was added:
+ ----- Method: HtmlBody>>shouldContain: (in category 'lint') -----
+ shouldContain: anEntity
+ 	"I don't *think* there are any elements that can be in both the header and the body..."
+ 	^anEntity isHeadElement not!

Item was added:
+ ----- Method: HtmlBody>>tagName (in category 'testing') -----
+ tagName
+ 	^'body'!

Item was added:
+ HtmlFontChangeEntity subclass: #HtmlBoldEntity
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlBoldEntity commentStamp: '<historical>' prior: 0!
+ an entity which displays its contents in boldface!

Item was added:
+ ----- Method: HtmlBoldEntity>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter increaseBold.
+ 	super addToFormatter: formatter.
+ 	formatter decreaseBold.!

Item was added:
+ HtmlSpecialEntity subclass: #HtmlBreak
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlBreak>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter addChar: Character cr.!

Item was added:
+ ----- Method: HtmlBreak>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^false!

Item was added:
+ ----- Method: HtmlBreak>>tagName (in category 'testing') -----
+ tagName
+ 	^'br'!

Item was added:
+ HtmlFormEntity subclass: #HtmlButton
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlButton>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^false!

Item was added:
+ ----- Method: HtmlButton>>tagName (in category 'testing') -----
+ tagName
+ 	^'button'!

Item was added:
+ HtmlToken subclass: #HtmlComment
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Tokenizer'!
+ 
+ !HtmlComment commentStamp: '<historical>' prior: 0!
+ A comment, eg <!!-- this is a comment -->
+ Normally this is ignored, but it's included so that every byte in the
+ input gets put into one tag or another.!

Item was added:
+ ----- Method: HtmlComment>>entityFor (in category 'parser support') -----
+ entityFor
+ 	^self shouldNotImplement!

Item was added:
+ ----- Method: HtmlComment>>isComment (in category 'properties') -----
+ isComment
+ 	^true!

Item was added:
+ ----- Method: HtmlComment>>text (in category 'access') -----
+ text
+ 	"return the text of the comment, the part inside the <!!-- and -->"
+ 	^self notYetImplemented!

Item was added:
+ HtmlTextualEntity subclass: #HtmlCommentEntity
+ 	instanceVariableNames: 'commentText'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlCommentEntity commentStamp: '<historical>' prior: 0!
+ a comment from the page!

Item was added:
+ ----- Method: HtmlCommentEntity>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	"do nothing"!

Item was added:
+ ----- Method: HtmlCommentEntity>>commentText (in category 'access') -----
+ commentText
+ 	^commentText!

Item was added:
+ ----- Method: HtmlCommentEntity>>initializeWithText: (in category 'private-iniitialization') -----
+ initializeWithText: aString
+ 	super initialize.
+ 	commentText _ aString.!

Item was added:
+ ----- Method: HtmlCommentEntity>>isComment (in category 'testing') -----
+ isComment
+ 	^true!

Item was added:
+ ----- Method: HtmlCommentEntity>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^false!

Item was added:
+ ----- Method: HtmlCommentEntity>>printHtmlOn:indent: (in category 'printing') -----
+ printHtmlOn: aStream indent: indent 
+ 	indent timesRepeat: [aStream space].
+ 	aStream nextPutAll: '<!!-- '.
+ 	aStream nextPutAll: self commentText.
+ 	aStream nextPutAll: ' -->'.
+ 	aStream cr!

Item was added:
+ ----- Method: HtmlCommentEntity>>printOn:indent: (in category 'printing') -----
+ printOn: aStream indent: indent 
+ 	self printHtmlOn: aStream indent: indent!

Item was added:
+ ----- Method: HtmlCommentEntity>>tagName (in category 'testing') -----
+ tagName	
+ 	"return a bogus tag name"
+ 	^'x-comment'!

Item was added:
+ HtmlDefinitionListElement subclass: #HtmlDefinitionDefinition
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlDefinitionDefinition>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter ensureNewlines: 1.
+ 	formatter increaseIndent.
+ 	super addToFormatter: formatter.
+ 	formatter decreaseIndent.!

Item was added:
+ ----- Method: HtmlDefinitionDefinition>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isBlockEntity or: [ anEntity isTextualEntity ] !

Item was added:
+ ----- Method: HtmlDefinitionDefinition>>tagName (in category 'testing') -----
+ tagName
+ 	^'dd'!

Item was added:
+ HtmlBlockEntity subclass: #HtmlDefinitionList
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlDefinitionList>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	super addToFormatter: formatter.
+ 	formatter ensureNewlines: 1.!

Item was added:
+ ----- Method: HtmlDefinitionList>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isDefinitionListElement!

Item was added:
+ ----- Method: HtmlDefinitionList>>tagName (in category 'testing') -----
+ tagName
+ 	^'dl'!

Item was added:
+ HtmlEntity subclass: #HtmlDefinitionListElement
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlDefinitionListElement>>isDefinitionListElement (in category 'testing') -----
+ isDefinitionListElement
+ 	^true!

Item was added:
+ HtmlDefinitionListElement subclass: #HtmlDefinitionTerm
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlDefinitionTerm>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter ensureNewlines: 1.
+ 	super addToFormatter: formatter.!

Item was added:
+ ----- Method: HtmlDefinitionTerm>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isTextualEntity!

Item was added:
+ ----- Method: HtmlDefinitionTerm>>tagName (in category 'testing') -----
+ tagName
+ 	^'dt'!

Item was added:
+ HtmlEntity subclass: #HtmlDocument
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlDocument commentStamp: '<historical>' prior: 0!
+ an entire HTML document.  It should have exactly two sub-entities when completed: a HEAD and a BODY!

Item was added:
+ ----- Method: HtmlDocument class>>emptyDocument (in category 'instance creation') -----
+ emptyDocument
+ 	"return an empty document"
+ 	^super new add: HtmlHead new; add: HtmlBody new!

Item was added:
+ ----- Method: HtmlDocument>>addToBody: (in category 'access') -----
+ addToBody: anObject
+ 	"add an object to the Body entity of the receiver"
+ 	self body add: anObject!

Item was added:
+ ----- Method: HtmlDocument>>addToHead: (in category 'access') -----
+ addToHead: anObject
+ 	"add an object to the head entity of the receiver"
+ 	self head add: anObject!

Item was added:
+ ----- Method: HtmlDocument>>body (in category 'access') -----
+ body
+ 	^self contents at: 2!

Item was added:
+ ----- Method: HtmlDocument>>formattedText (in category 'formatting') -----
+ formattedText
+ 	"return a version of this document as a formatted Text"
+ 	| formatter |
+ 	formatter _ HtmlFormatter preferredFormatterClass new.
+ 	self addToFormatter: formatter.
+ 	^formatter text !

Item was added:
+ ----- Method: HtmlDocument>>formattedTextForBrowser:defaultBaseUrl: (in category 'formatting') -----
+ formattedTextForBrowser: browser  defaultBaseUrl: defaultBaseUrl
+ 	"return a version of this document as a formatted Text (which includes links and such)"
+ 	| formatter text |
+ 
+ 	"set up the formatter"
+ 	formatter _ HtmlFormatter preferredFormatterClass new.
+ 	formatter browser: browser.
+ 	formatter baseUrl: defaultBaseUrl.  "should check if the document specifies something else"
+ 
+ 	"do the formatting"
+ 	self addToFormatter: formatter.
+ 
+ 	"get and return the result"
+ 	text _ formatter text.
+ 	^text!

Item was added:
+ ----- Method: HtmlDocument>>formattedTextMorph (in category 'formatting') -----
+ formattedTextMorph
+ 	"return a version of this document as a formatted TextMorph (which includes links and such)"
+ 	| formatter text textMorph |
+ 	formatter _ HtmlFormatter preferredFormatterClass new.
+ 	self addToFormatter: formatter.
+ 	text _ formatter text .
+ 
+ 	textMorph _ TextMorph new initialize.
+ 	textMorph contentsWrapped: text.
+ 
+ 	^textMorph!

Item was added:
+ ----- Method: HtmlDocument>>formattedTextMorphForBrowser:defaultBaseUrl: (in category 'formatting') -----
+ formattedTextMorphForBrowser: browser  defaultBaseUrl: defaultBaseUrl
+ 	"return a version of this document as a formatted TextMorph (which includes links and such)"
+ 	| formatter textMorph |
+ 
+ 	"set up the formatter"
+ 	formatter _ HtmlFormatter preferredFormatterClass new.
+ 	formatter browser: browser.
+ 	formatter baseUrl: defaultBaseUrl.  "should check if the document specifies something else"
+ 
+ 	"do the formatting"
+ 	self addToFormatter: formatter.
+ 
+ 	"get and return the result"
+ 	textMorph _ formatter textMorph .
+ 	^textMorph!

Item was added:
+ ----- Method: HtmlDocument>>head (in category 'access') -----
+ head
+ 	^self contents at: 1!

Item was added:
+ ----- Method: HtmlDocument>>mayContain: (in category 'testing') -----
+ mayContain: anElement
+ 	^true 	"not strictly true, but it makes the parser simpler"!

Item was added:
+ ----- Method: HtmlDocument>>tagName (in category 'testing') -----
+ tagName
+ 	^'html'!

Item was added:
+ HtmlSpecialEntity subclass: #HtmlEmbedded
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'ExtensionList'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlEmbedded class>>initialize (in category 'initialize') -----
+ initialize
+ 	"HtmlEmbedded initialize"
+ 	ExtensionList _ Dictionary new.
+ 	#(
+ 		('swf'	FlashPlayerMorph)
+ 	) do:[:spec| ExtensionList at: spec first put: spec last].!

Item was added:
+ ----- Method: HtmlEmbedded>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	| url embeddedMorph |
+ 	self src isNil ifTrue:[^self].
+ 	url _ self src.
+ 	embeddedMorph _ self embeddedMorphFor: url.
+ 	embeddedMorph isNil ifTrue:[^self].
+ 	formatter baseUrl ifNotNil:[url _ url asUrlRelativeTo: formatter baseUrl].
+ 	embeddedMorph extent: self extent.
+ 	embeddedMorph sourceUrl: url.
+ 	embeddedMorph setProperty: #embedded toValue: true.
+ 	formatter addIncompleteMorph: embeddedMorph.!

Item was added:
+ ----- Method: HtmlEmbedded>>embeddedMorphClassFor: (in category 'formatting') -----
+ embeddedMorphClassFor: url
+ 	| lastIndex extension className |
+ 	lastIndex _ url findLast:[:c| c = $.].
+ 	lastIndex = 0 ifTrue:[^nil].
+ 	extension _ url copyFrom: lastIndex+1 to: url size.
+ 	className _ ExtensionList at: extension asLowercase ifAbsent:[^nil].
+ 	^Smalltalk at: className ifAbsent:[nil]
+ 	!

Item was added:
+ ----- Method: HtmlEmbedded>>embeddedMorphFor: (in category 'formatting') -----
+ embeddedMorphFor: url
+ 	| morphClass |
+ 	morphClass _ self embeddedMorphClassFor: url.
+ 	^morphClass ifNotNil:[morphClass new]!

Item was added:
+ ----- Method: HtmlEmbedded>>extent (in category 'attributes') -----
+ extent
+ 	"the image extent, according to the WIDTH and HEIGHT attributes.  returns nil if either WIDTH or HEIGHT is not specified"
+ 	| widthText heightText |
+ 	widthText _ self getAttribute: 'width' ifAbsent: [ ^nil ].
+ 	heightText _ self getAttribute: 'height' ifAbsent: [ ^nil ].
+ 	^ widthText asNumber @ heightText asNumber!

Item was added:
+ ----- Method: HtmlEmbedded>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^false!

Item was added:
+ ----- Method: HtmlEmbedded>>src (in category 'attributes') -----
+ src
+ 	^self getAttribute: 'src' default: nil!

Item was added:
+ ----- Method: HtmlEmbedded>>tagName (in category 'testing') -----
+ tagName
+ 	^'embed'!

Item was added:
+ Object subclass: #HtmlEntity
+ 	instanceVariableNames: 'contents attribs'
+ 	classVariableNames: 'ReverseCharacterEntities'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser'!
+ 
+ !HtmlEntity commentStamp: '<historical>' prior: 0!
+ <html>When HtmlParser runs, it generates a tree whose nodes are in HtmlEntity's subclasses.  There is a separate class for most of the available elements in HTML, though some are grouped together under generic classes like HtmlBoldEntity.
+ 
+ Methods of particular interest when modifying or adding subclasses are:
+ <ul>
+ <li>initialize:
+ <li>mayContain:
+ <li>addToFormatter:
+ </ul>
+ !

Item was added:
+ ----- Method: HtmlEntity class>>convertToNumber: (in category 'character entities') -----
+ convertToNumber: aString
+ 	"HtmlEntity convertToNumber: '25'"
+ 	"HtmlEntity convertToNumber: 'xb7'"
+ 	"HtmlEntity convertToNumber: 'o10'"
+ 	| str ch |
+ 	str := ReadStream on: aString asUppercase.
+ 	ch := str peek.
+ 	ch = $X ifTrue: [ str next. ^Number readFrom: str base: 16 ].
+ 	ch = $O ifTrue: [ str next. ^Number readFrom: str base: 8 ].
+ 	ch = $B ifTrue: [ str next. ^Number readFrom: str base: 2 ].
+ 	^Number readFrom: str!

Item was added:
+ ----- Method: HtmlEntity class>>forTag: (in category 'instance creation') -----
+ forTag: aTag
+ 	"create a new entity based on the given tag"
+ 	^self new initialize: aTag!

Item was added:
+ ----- Method: HtmlEntity class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"HtmlEntity initialize"
+ 
+ 	ReverseCharacterEntities _ Dictionary new: 128.
+ 	#('quot' $" 'lt' $< 'amp' $& 'gt' $> 'rsquo' $' 'lsquo' $` 'rdquo' $" 'ldquo' $" ) pairsDo:
+ 		[:s :c | ReverseCharacterEntities at: s put: c asciiValue].
+ 	#('nbsp' 'iexcl' 'cent' 'pound' 'curren' 'yen' 'brvbar' 'sect' 'uml' 'copy' 'ordf' 'laquo' 'not' 'shy' 'reg' 'hibar' 'deg' 'plusmn' 'sup2' 'sup3' 'acute' 'micro' 'para' 'middot' 'cedil' 'sup1' 'ordm' 'raquo' 'frac14' 'frac12' 'frac34' 'iquest' 'Agrave' 'Aacute' 'Acirc' 'Atilde' 'Auml' 'Aring' 'AElig' 'Ccedil' 'Egrave' 'Eacute' 'Ecirc' 'Euml' 'Igrave' 'Iacute' 'Icirc' 'Iuml' 'ETH' 'Ntilde' 'Ograve' 'Oacute' 'Ocirc' 'Otilde' 'Ouml' 'times' 'Oslash' 'Ugrave' 'Uacute' 'Ucirc' 'Uuml' 'Yacute' 'THORN' 'szlig' 'agrave' 'aacute' 'acirc' 'atilde' 'auml' 'aring' 'aelig' 'ccedil' 'egrave' 'eacute' 'ecirc' 'euml' 'igrave' 'iacute' 'icirc' 'iuml' 'eth' 'ntilde' 'ograve' 'oacute' 'ocirc' 'otilde' 'ouml' 'divide' 'oslash' 'ugrave' 'uacute' 'ucirc' 'uuml' 'yacute' 'thorn' 'yuml' ) withIndexDo:
+ 		[:s :i | ReverseCharacterEntities at: s put: i - 1 + 160].!

Item was added:
+ ----- Method: HtmlEntity class>>new (in category 'instance creation') -----
+ new
+ 	^super new initialize!

Item was added:
+ ----- Method: HtmlEntity class>>valueOfHtmlEntity: (in category 'character entities') -----
+ valueOfHtmlEntity: specialEntity
+ 	"Return the character equivalent to the HTML entity."
+ 
+ 	| value |
+ 	(specialEntity beginsWith: '#')		"Handle numeric entities"
+ 		ifTrue: [
+ 			"NB: We can display only simple numeric special entities in the"
+ 			"range [9..255] (HTML 3.2).  HTML 4.01 allows the specification of 16 bit"
+ 			"characters, so we do a little fiddling to handle a few special cases"
+ 
+ 			value _ self convertToNumber: (specialEntity copyFrom: 2 to: specialEntity size).
+ 
+ 			"Replace rounded left & right double quotes (HTML 4.01) with simple double quote"
+ 			(value = 8220 or: [value = 8221]) ifTrue: [ value _ $" asInteger ].
+ 
+ 			"Replace rounded left & right single quotes (HTML 4.01) with simple single quote"
+ 			(value = 8216 or: [value = 8217]) ifTrue: [ value _ $' asInteger ].
+ 
+ 			"Replace with a space if outside the normal range (arbitrary choice)"
+ 			(value < 9 or: [value > 255]) ifTrue: [ value _ 32 ].
+ 			]
+ 		ifFalse: [
+ 			"Otherwise this is most likely a named character entity"
+ 			value _ ReverseCharacterEntities at: specialEntity ifAbsent: [^nil].
+ 			].
+ 
+ 	 ^Character value: value.!

Item was added:
+ ----- Method: HtmlEntity>>add: (in category 'accessing') -----
+ add: anObject
+ 	"add an object to the receiver"
+ 	(anObject isKindOf: String)
+ 		ifTrue: [contents add: (HtmlTextEntity new text: anObject)]
+ 		ifFalse: [contents add: anObject]!

Item was added:
+ ----- Method: HtmlEntity>>addEntity: (in category 'contents') -----
+ addEntity: anEntity
+ 	"add an entity to the receiver"
+ 	contents add: anEntity!

Item was added:
+ ----- Method: HtmlEntity>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: aFormatter
+ 	"by default, just format our childer"
+ 	contents do: [ :e | e addToFormatter: aFormatter ]!

Item was added:
+ ----- Method: HtmlEntity>>allSubentitiesDo: (in category 'enumeration') -----
+ allSubentitiesDo: aBlock
+ 	"perform the block recursively on all sub-entities"
+ 	contents do: [ :e | 
+ 		aBlock value: e .
+ 		e allSubentitiesDo: aBlock.
+ 	].
+ 	!

Item was added:
+ ----- Method: HtmlEntity>>asHtml (in category 'converting') -----
+ asHtml
+ 	| aStream |
+ 	aStream := WriteStream on: ''.
+ 	self printHtmlOn: aStream.
+ 	^aStream contents.!

Item was added:
+ ----- Method: HtmlEntity>>at:put: (in category 'accessing') -----
+ at: key put: anObject
+ 	self attributes ifNil: [self attributes: (HtmlAttributes new)].
+ 	(self attributes) at: key put: anObject!

Item was added:
+ ----- Method: HtmlEntity>>attributes (in category 'accessing') -----
+ attributes
+ 	^attribs ifNil: [attribs := HtmlAttributes new]!

Item was added:
+ ----- Method: HtmlEntity>>attributes: (in category 'attributes') -----
+ attributes: newAttributes
+ 	"set all of the attributes at once.  newAttributes should not be modified after passing it in"
+ 	^attribs _ newAttributes!

Item was added:
+ ----- Method: HtmlEntity>>contents (in category 'contents') -----
+ contents
+ 	"return an ordered collection of this entity's contents"
+ 	^contents!

Item was added:
+ ----- Method: HtmlEntity>>doesNotUnderstand: (in category 'attributes') -----
+ doesNotUnderstand: aMessage
+ 	"treat the message as an attribute name"
+ 	| selector |
+ 	selector _ aMessage selector.
+ 
+ 	selector asLowercase = selector ifFalse: [
+ 		"attribute accesses must be in all lowercase.  This should cut down on some false doesNotUnderstand: traps"
+ 		^super doesNotUnderstand: aMessage ].
+ 
+ 	selector numArgs == 0 ifTrue: [
+ 		"return the named attribute"
+ 		^self getAttribute: selector asString default: nil ].
+ 
+ 
+ 	selector numArgs == 1 ifTrue: [
+ 		"set the named attribute"
+ 		self setAttribute: (selector asString copyFrom: 1 to: (selector size-1)) to: aMessage argument.
+ 		^self ].
+ 
+ 	^super doesNotUnderstand: aMessage!

Item was added:
+ ----- Method: HtmlEntity>>downloadState: (in category 'downloading') -----
+ downloadState: baseUrl
+ 	"download any state needed for full rendering.  eg, images need this"
+ 	!

Item was added:
+ ----- Method: HtmlEntity>>getAttribute: (in category 'attributes') -----
+ getAttribute: name
+ 	^self getAttribute: name  default: nil!

Item was added:
+ ----- Method: HtmlEntity>>getAttribute:default: (in category 'attributes') -----
+ getAttribute: name  default: anObject
+ 	^self getAttribute: name  ifAbsent: [anObject]!

Item was added:
+ ----- Method: HtmlEntity>>getAttribute:ifAbsent: (in category 'attributes') -----
+ getAttribute: name  ifAbsent: aBlock
+ 	^attribs at: name ifAbsent: aBlock!

Item was added:
+ ----- Method: HtmlEntity>>initialize (in category 'private-initialization') -----
+ initialize
+ 	contents _ OrderedCollection new.
+ 	attribs _ HtmlAttributes new.!

Item was added:
+ ----- Method: HtmlEntity>>initialize: (in category 'private-initialization') -----
+ initialize: aTag
+ 	self initialize.
+ 	attribs _ HtmlAttributes newFrom: aTag attribs.!

Item was added:
+ ----- Method: HtmlEntity>>inspect (in category 'user interface') -----
+ inspect
+ 	"Open an HtmlEntityInspector on the receiver.
+ 	Use basicInspect to get a normal type of inspector."
+ 
+ 	HtmlEntityInspector openOn: self withEvalPane: true!

Item was added:
+ ----- Method: HtmlEntity>>inspectWithLabel: (in category 'user interface') -----
+ inspectWithLabel: aLabel
+ 	"Open a HtmlEntityInspector on the receiver. Use basicInspect to get a normal (less useful) type of inspector."
+ 
+ 	HtmlEntityInspector openOn: self withEvalPane: true withLabel: aLabel!

Item was added:
+ ----- Method: HtmlEntity>>isArea (in category 'testing') -----
+ isArea
+ 	^false!

Item was added:
+ ----- Method: HtmlEntity>>isBlockEntity (in category 'testing') -----
+ isBlockEntity
+ 	^false!

Item was added:
+ ----- Method: HtmlEntity>>isComment (in category 'testing') -----
+ isComment
+ 	^false!

Item was added:
+ ----- Method: HtmlEntity>>isDefinitionListElement (in category 'testing') -----
+ isDefinitionListElement
+ 	"whether receiver can appear in a DefinitionList"
+ 	^false!

Item was added:
+ ----- Method: HtmlEntity>>isFormEntity (in category 'testing') -----
+ isFormEntity
+ 	^false!

Item was added:
+ ----- Method: HtmlEntity>>isFrame (in category 'categorization') -----
+ isFrame
+ 	^false!

Item was added:
+ ----- Method: HtmlEntity>>isFrameSet (in category 'categorization') -----
+ isFrameSet
+ 	^false!

Item was added:
+ ----- Method: HtmlEntity>>isHeadElement (in category 'testing') -----
+ isHeadElement
+ 	"whether this can appear in a header"
+ 	^false!

Item was added:
+ ----- Method: HtmlEntity>>isHeader (in category 'testing') -----
+ isHeader
+ 	^false!

Item was added:
+ ----- Method: HtmlEntity>>isListElement (in category 'testing') -----
+ isListElement
+ 	"is this an HtmlListElement, ie can it appear in a (non-definition) list?"
+ 	^false!

Item was added:
+ ----- Method: HtmlEntity>>isListItem (in category 'testing') -----
+ isListItem
+ 	"is this an HtmlListItem, ie can it appear in a (non-definition) list?"
+ 	^false!

Item was added:
+ ----- Method: HtmlEntity>>isOption (in category 'testing') -----
+ isOption
+ 	"whether this is an <option> entity"
+ 	^false!

Item was added:
+ ----- Method: HtmlEntity>>isParagraph (in category 'testing') -----
+ isParagraph
+ 	^false!

Item was added:
+ ----- Method: HtmlEntity>>isTableDataItem (in category 'testing') -----
+ isTableDataItem
+ 	^false!

Item was added:
+ ----- Method: HtmlEntity>>isTableItem (in category 'testing') -----
+ isTableItem
+ 	^false!

Item was added:
+ ----- Method: HtmlEntity>>isTableRow (in category 'testing') -----
+ isTableRow
+ 	^false!

Item was added:
+ ----- Method: HtmlEntity>>isTextualEntity (in category 'testing') -----
+ isTextualEntity
+ 	"is receiver either text, or some low-level text-like entity such as <b> or <em>"
+ 	^false!

Item was added:
+ ----- Method: HtmlEntity>>lint (in category 'testing') -----
+ lint
+ 	^String streamContents: [ :s | self lint: s ]!

Item was added:
+ ----- Method: HtmlEntity>>lint: (in category 'testing') -----
+ lint: aStream
+ 	"do a lint check, reporting to aStream"
+ 	self lintAttributes: aStream.
+ 
+ 	contents do: [ :c |
+ 		(c isComment not   and:  [ (self shouldContain: c) not ]) ifTrue: [ 
+ 			aStream nextPutAll: '<', self tagName, '> should not contain <', c tagName, '>'.
+ 			aStream cr. ] ].
+ 
+ 	contents do: [ :c  | c lint: aStream ]!

Item was added:
+ ----- Method: HtmlEntity>>lintAttributes: (in category 'testing') -----
+ lintAttributes: aStream
+ 	"check that our attributes are okay.  Print any anomalies to aStream"
+ 	!

Item was added:
+ ----- Method: HtmlEntity>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	"whether we can contain the given entity"
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: HtmlEntity>>mayContainEntity: (in category 'testing') -----
+ mayContainEntity: anEntity
+ 	"whether we can contain the given entity"
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: HtmlEntity>>name (in category 'attributes') -----
+ name
+ 	^self getAttribute: 'name' default: nil!

Item was added:
+ ----- Method: HtmlEntity>>parsingFinished (in category 'formatting') -----
+ parsingFinished
+ 	"some entities need to make a final pass *after* parsing has finished and all the contents of each entity have been established; here is a place to do that"
+ 	contents do: [ :e | e parsingFinished ].!

Item was added:
+ ----- Method: HtmlEntity>>printHtmlOn: (in category 'printing') -----
+ printHtmlOn: aStream
+ 	^self printHtmlOn: aStream  indent: 0!

Item was added:
+ ----- Method: HtmlEntity>>printHtmlOn:indent: (in category 'printing') -----
+ printHtmlOn: aStream indent: indent 
+ 	aStream next: indent put: $ ;
+ 	 nextPutAll: '<';
+ 	 nextPutAll: self tagName.
+ 	self attributes associationsDo: [:assoc | aStream space; nextPutAll: assoc key; nextPutAll: '="'; nextPutAll: assoc value; nextPutAll: '"'].
+ 	aStream nextPut: $>;
+ 	 cr.
+ 	contents do: [:entity | entity printHtmlOn: aStream indent: indent + 1].
+ 	aStream nextPutAll: '</'; nextPutAll: self tagName; nextPutAll: '>'.!

Item was added:
+ ----- Method: HtmlEntity>>printOn: (in category 'printing') -----
+ printOn: aStream
+ 	^self printOn: aStream  indent: 0!

Item was added:
+ ----- Method: HtmlEntity>>printOn:indent: (in category 'printing') -----
+ printOn: aStream  indent: indent
+ 	aStream
+ 		next: indent put: $ ;
+ 		nextPut: $<;
+ 		print: self tagName.
+ 
+ 	self attributes associationsDo: [ :assoc |
+ 		aStream
+ 			space;
+ 			nextPutAll: assoc key;
+ 			nextPutAll: '=';
+ 			nextPutAll: assoc value ].
+ 
+ 	aStream
+ 		nextPut: $>;
+ 		cr.
+ 	contents do: [ :entity | entity printOn: aStream indent: indent+1 ].!

Item was added:
+ ----- Method: HtmlEntity>>removeEntity: (in category 'contents') -----
+ removeEntity: anEntity 
+ 	"remove the specified entity"
+ 	contents remove: anEntity!

Item was added:
+ ----- Method: HtmlEntity>>setAttribute:to: (in category 'attributes') -----
+ setAttribute: name  to: value
+ 	"set the given attribute to the given value"
+ 	attribs at: name asLowercase  put: value!

Item was added:
+ ----- Method: HtmlEntity>>shouldContain: (in category 'testing') -----
+ shouldContain: anEntity
+ 	"whether, according to the HTML DTD, this element should actually contain anEntity.  Used for checking the quality of a pages HTML"
+ 	^self mayContain: anEntity!

Item was added:
+ ----- Method: HtmlEntity>>subEntities (in category 'contents') -----
+ subEntities
+ 	"return an ordered collection of this entity's contents"
+ 	^ contents!

Item was added:
+ ----- Method: HtmlEntity>>tagName (in category 'testing') -----
+ tagName
+ 	"tag name for ourself"
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: HtmlEntity>>textualContents (in category 'contents') -----
+ textualContents
+ 	"return a string with the concatenated contents of all textual sub-entities"
+ 	^String streamContents: [ :s |
+ 		contents do: [ :e | s nextPutAll: e textualContents ] ]!

Item was added:
+ Inspector subclass: #HtmlEntityInspector
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser'!

Item was added:
+ ----- Method: HtmlEntityInspector>>fieldList (in category 'accessing') -----
+ fieldList
+ 	^ super fieldList, (Array with: 'asHtml')!

Item was added:
+ ----- Method: HtmlEntityInspector>>initialExtent (in category 'accessing') -----
+ initialExtent
+ 	"Answer the desired extent for the receiver when it is first opened on the screen.  "
+ 
+ 	^ 300 @ 300!

Item was added:
+ ----- Method: HtmlEntityInspector>>selection (in category 'selecting') -----
+ selection
+ 	selectionIndex = self fieldList size 
+ 		ifTrue: [^object asHtml]
+ 		ifFalse: [^super selection]!

Item was added:
+ HtmlFontChangeEntity subclass: #HtmlFixedWidthEntity
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlFixedWidthEntity commentStamp: '<historical>' prior: 0!
+ An entity that (supposedly) displays its contents in a fixed-width font.  I don't know how to do this, though.  -ls!

Item was added:
+ HtmlTextualEntity subclass: #HtmlFontChangeEntity
+ 	instanceVariableNames: 'tagName'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlFontChangeEntity commentStamp: '<historical>' prior: 0!
+ an entity whose effect is to change the font its constituents are displayed in in some way.  Multiple tags might generate almost any of the subclasses, so the tag name is stored explicitly.!

Item was added:
+ ----- Method: HtmlFontChangeEntity>>initialize: (in category 'private-initialization') -----
+ initialize: aTag
+ 	super initialize: aTag.
+ 	tagName _ aTag name!

Item was added:
+ ----- Method: HtmlFontChangeEntity>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isTextualEntity!

Item was added:
+ ----- Method: HtmlFontChangeEntity>>tagName (in category 'testing') -----
+ tagName
+ 	"must be stored in an i-var, because these classes work for different tags"
+ 	^tagName!

Item was added:
+ HtmlFontChangeEntity subclass: #HtmlFontEntity
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlFontEntity commentStamp: '<historical>' prior: 0!
+ the <font> tag.  it's here for future expansion....!

Item was added:
+ ----- Method: HtmlFontEntity>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	| size color textAttribList |
+ 	(formatter respondsTo: #startFont:)
+ 		ifFalse: [^super addToFormatter: formatter].
+ 	size _ self getAttribute: 'size'.
+ 	color _ self getAttribute: 'color'.
+ 	textAttribList _ OrderedCollection new.
+ 	color ifNotNil: [textAttribList add: (TextColor color: (Color fromString: color))].
+ 	(size isEmptyOrNil not and: [size isAllDigits]) 
+ 		ifTrue: [size _ (size asNumber - 3) max: 1.
+ 			textAttribList add: (TextFontChange fontNumber: (size min: 4))].
+ 	formatter startFont: textAttribList.
+ 	super addToFormatter: formatter.
+ 	formatter endFont: textAttribList!

Item was added:
+ HtmlEntity subclass: #HtmlForm
+ 	instanceVariableNames: 'formEntities'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlForm>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter startForm: self.
+ 	super addToFormatter: formatter.
+ 	formatter currentFormData reset.
+ 	formatter endForm.!

Item was added:
+ ----- Method: HtmlForm>>encoding (in category 'attributes') -----
+ encoding
+ 	"encoding for posting"
+ 	^self getAttribute: 'enctype' default: nil.  !

Item was added:
+ ----- Method: HtmlForm>>formEntities (in category 'access') -----
+ formEntities
+ 	^formEntities!

Item was added:
+ ----- Method: HtmlForm>>isBlockElement (in category 'testing') -----
+ isBlockElement
+ 	^true!

Item was added:
+ ----- Method: HtmlForm>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	"allow anything.  People probably always put </form> anyway at the end of their forms.  And furthermore, it has no effect on the display, even if this is gotten wrong"
+ 	^true!

Item was added:
+ ----- Method: HtmlForm>>method (in category 'attributes') -----
+ method
+ 	"method to submit with"
+ 	^self getAttribute: 'method' default: 'get'!

Item was added:
+ ----- Method: HtmlForm>>parsingFinished (in category 'parsing') -----
+ parsingFinished
+ 	"figure out who our constituents are"
+ 
+ 	self allSubentitiesDo: [ :e |
+ 		e isFormEntity ifTrue: [ e form: self ] ].
+ 	super parsingFinished.
+ 	formEntities _ OrderedCollection new.
+ 	self allSubentitiesDo: [ :e |
+ 		(e isFormEntity and: [ e form == self ])
+ 			ifTrue: [ formEntities add: e ] ].!

Item was added:
+ ----- Method: HtmlForm>>tagName (in category 'testing') -----
+ tagName
+ 	^'form'!

Item was added:
+ ----- Method: HtmlForm>>url (in category 'attributes') -----
+ url
+ 	"url to submit to"
+ 	^self getAttribute: 'action' default: nil.  !

Item was added:
+ HtmlEntity subclass: #HtmlFormEntity
+ 	instanceVariableNames: 'form'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlFormEntity commentStamp: '<historical>' prior: 0!
+ Abstract superclass for elements that only appear in forms!

Item was added:
+ ----- Method: HtmlFormEntity>>form (in category 'access') -----
+ form
+ 	"return which form we are in"
+ 	^form!

Item was added:
+ ----- Method: HtmlFormEntity>>form: (in category 'access') -----
+ form: aForm
+ 	"set which form we are part of"
+ 	form _ aForm!

Item was added:
+ ----- Method: HtmlFormEntity>>isFormEntity (in category 'testing') -----
+ isFormEntity
+ 	^true!

Item was added:
+ ----- Method: HtmlFormEntity>>lint: (in category 'testing') -----
+ lint: aStream
+ 	form ifNil: [ aStream nextPutAll: '<', self tagName, '> not within a form'.
+ 		aStream cr. ].
+ 	super lint: aStream.!

Item was added:
+ Object subclass: #HtmlFormatter
+ 	instanceVariableNames: 'browser baseUrl formDatas outputStream preformattedLevel indentLevel boldLevel italicsLevel underlineLevel strikeLevel centerLevel urlLink listLengths listTypes precedingSpaces precedingNewlines morphsToEmbed incompleteMorphs anchorLocations imageMaps'
+ 	classVariableNames: 'CSNonSeparators CSSeparators'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Formatter'!
+ 
+ !HtmlFormatter commentStamp: 'ls 10/28/2003 11:56' prior: 0!
+ A filter which formats an HtmlDocument into a nice-looking Text suitable for a web browser such as Scamper.  See HtmlFormatter class example1 for usage information.
+ 
+ In principle, this formatter, along with the associated addToFormatter: methods, attempts to format any HTML which is fed to it.
+ !

Item was added:
+ ----- Method: HtmlFormatter class>>example1 (in category 'examples') -----
+ example1
+ 	"(HtmlFormatter example1 asParagraph compositionRectangle: (0 at 0 extent: 300 at 500) ) displayAt: 0 at 0"
+ 	| input |
+ 	input _ ReadStream on: 
+ '<html>
+ <head>
+ <title>The Gate of Chaos</title>
+ </head>
+ 
+ <body>
+ 
+ <h1>Chaos</h1>
+ 
+ 
+ 
+ <h2>Into the Maelstrom</h2>
+ Direction is useless in the ever-changing Maelstrom.  However,
+ if you wander with purpose, you might be able to find....
+ <ul>
+ <li><a href="/cgi-bin/w">see who''s logged in</a>
+ <li><a href="/Telnet/connect.html">log in, if you (oooh) have an account</a>
+ <li><a href="http://chaos.resnet.gatech.edu:9000/sw">The Chaos Swiki</a>--scribble on chaos
+ <li>the original <a href="/cgi-bin/guestlog-print">Visitor Sands</a>
+ <li>my old <a href="rant.html">Rant Page</a>
+ <li>neverending <a href="/cgi-bin/bread">poll</a>: do you have an opinion on bread?
+ <li>a <a href="http://www.cc.gatech.edu/~lex/linux.html">Linux page</a>-- free UNIX for PC''s!!
+ <li><a href="english.au">Hear Linus Himself speak!!!!</a>
+ <li><a href="/doc/">some docs on all kinds of computer stuff</a>
+ </ul>
+ 
+ <hr>
+ 
+ 
+ <h2>Paths of Retreat</h2>
+ Several commonly travelled ways have left paths leading 
+ <em>away</em> from the maelstrom, too:
+ <p>
+ <ul>
+ <li><a href="friends.html">Friends of Chaos</a>
+ <li><a href="http://www.apache.org/">The <em>Apache</em> home page</a> -- 
+         <em>Chaos</em>''s WWW server!!
+ <li><a href="http://www.ee.umanitoba.ca/~djc/personal/notscape.html">
+ Notscape</a>
+ 
+ the <a href="http://www.eskimo.com/%7Eirving/anti-ns/">Anti-Netscape
+ Page</a> -- fight the tyranny!!
+ </ul>
+ 
+ <hr>
+ <a href="/analog/usage.html">usage stats</a> for this server
+ 
+ <hr>
+ <a href="http://www.eff.org/blueribbon.html"><img src="blueribbon.gif" alt="[blue ribbon campaign]"></a>
+ <a href="http://www.ee.umanitoba.ca/~djc/personal/notscape.html">
+ <img src="notscape.gif" alt="[NOTscape]">
+ </a>
+ <a href="http://www.anybrowser.org/campaign/">
+ <img src="anybrowser3.gif" alt="[Best Viewed With Any Browser"]></a>
+ </body>
+ </html>'.
+ 	^(HtmlParser parse: input) formattedText!

Item was added:
+ ----- Method: HtmlFormatter class>>initialize (in category 'initialization') -----
+ initialize
+ 	"HtmlFormatter initialize"
+ 
+ 	CSSeparators _ CharacterSet separators.
+ 	CSNonSeparators _ CSSeparators complement.!

Item was added:
+ ----- Method: HtmlFormatter class>>new (in category 'instance creation') -----
+ new
+ 	^super new initialize!

Item was added:
+ ----- Method: HtmlFormatter class>>preferredFormatterClass (in category 'instance creation') -----
+ preferredFormatterClass
+ 	^DHtmlFormatter!

Item was added:
+ ----- Method: HtmlFormatter>>addChar: (in category 'formatting commands') -----
+ addChar: c
+ 	"add a single character, updating all the tallies"
+ 
+ 	"add the character to the output"
+ 	outputStream nextPut: c.
+ 
+ 	"update counters for preceeding spaces and preceding newlines"
+ 	(c = Character space or: [ c = Character tab ]) 
+ 	ifTrue: [ precedingSpaces _ precedingSpaces+1.  precedingNewlines _ 0 ]
+ 	ifFalse: [
+ 		(c = Character cr) ifTrue: [
+ 			precedingSpaces _ 0.
+ 			precedingNewlines _ precedingNewlines + 1 ]
+ 		ifFalse: [
+ 			precedingSpaces _ precedingNewlines _ 0 ] ].!

Item was added:
+ ----- Method: HtmlFormatter>>addImageMap: (in category 'image maps') -----
+ addImageMap: anImageMap
+ 	imageMaps addLast: anImageMap!

Item was added:
+ ----- Method: HtmlFormatter>>addIncompleteMorph: (in category 'formatting commands') -----
+ addIncompleteMorph: aMorph
+ 	"add a morph, and note that it needs to download some more state before reaching its ultimate state"
+ 	self addMorph: aMorph.
+ 	incompleteMorphs add: aMorph.!

Item was added:
+ ----- Method: HtmlFormatter>>addLink:url: (in category 'formatting commands') -----
+ addLink: text  url: url
+ 	"add a link with the given url and text"
+ 	| savedAttributes linkAttribute  |
+ 
+ 	"set up the link attribute"
+ 	linkAttribute _ TextURL new.
+ 	linkAttribute url: url.
+ 
+ 	"add the link to the stream"
+ 	savedAttributes _ outputStream currentAttributes.
+ 	outputStream currentAttributes: (savedAttributes, linkAttribute).
+ 	outputStream nextPutAll: text.
+ 	outputStream currentAttributes: savedAttributes.
+ 
+ 	"reset counters"
+ 	precedingSpaces _ precedingNewlines _ 0.!

Item was added:
+ ----- Method: HtmlFormatter>>addMorph: (in category 'formatting commands') -----
+ addMorph: aMorph
+ 	"add a morph to the output"
+ 	| savedAttributes |
+ 	self addChar: Character space.
+ 
+ 	savedAttributes _ outputStream currentAttributes.
+ 	outputStream currentAttributes: (savedAttributes copyWith: (TextAnchor new anchoredMorph: aMorph)).
+ 	self addChar: (Character value: 1).
+ 	outputStream currentAttributes: savedAttributes.
+ 
+ 	self addChar: Character space.
+ 
+ 	morphsToEmbed add: aMorph.!

Item was added:
+ ----- Method: HtmlFormatter>>addString: (in category 'formatting commands') -----
+ addString: aString
+ 	"adds the text in the given string.  It collapses spaces unless we are in a preformatted region"
+ 
+ 	| space compacted lastC i |
+ 
+ 	aString isEmpty ifTrue: [ ^self ].
+ 
+ 	space _ Character space.
+ 
+ 
+ 	preformattedLevel > 0 ifTrue: [
+ 		"add all the characters as literals"
+ 		outputStream nextPutAll: aString.
+ 
+ 		"update the counters"
+ 		lastC _ aString last.
+ 		(lastC = space or: [ lastC = Character cr ]) ifTrue: [
+ 			"how many of these are there?"
+ 			i _ aString size - 1.
+ 			[ i >= 1 and: [ (aString at: i) = lastC ] ] whileTrue: [ i _ i - 1 ].
+ 			i = 0 ifTrue: [
+ 				"the whole string is the same character!!"
+ 				lastC = space ifTrue: [
+ 					precedingSpaces _ precedingSpaces + aString size.
+ 					precedingNewlines _ 0.
+ 					^self ]
+ 				ifFalse: [
+ 					precedingSpaces _ 0.
+ 					precedingNewlines _ precedingNewlines + aString size.
+ 					^self ]. ].
+ 			lastC = space ifTrue: [
+ 				precedingSpaces _ aString size - i.
+ 				precedingNewlines _ 0 ]
+ 			ifFalse: [
+ 				precedingSpaces _ 0.
+ 				precedingNewlines _ aString size - i ] ] ]
+ 	ifFalse: [
+ 		compacted _ aString withSeparatorsCompacted.
+ 
+ 		compacted = ' ' ifTrue: [
+ 			"no letters in the string--just white space!!"
+ 			(precedingNewlines = 0 and: [precedingSpaces = 0]) ifTrue: [
+ 				precedingSpaces _ 1.
+ 				outputStream nextPut: space. ].
+ 			^self ].
+ 
+ 		(compacted first = Character space and: [
+ 			(precedingSpaces > 0) or: [ precedingNewlines > 0] ])
+ 		ifTrue: [ compacted _ compacted copyFrom: 2 to: compacted size ].
+ 
+ 		outputStream nextPutAll: compacted.
+ 
+ 		"update counters"
+ 		precedingNewlines _ 0.
+ 		compacted last = space 
+ 			ifTrue: [ precedingSpaces _ 1 ]
+ 			ifFalse: [ precedingSpaces _ 0 ]. ]!

Item was added:
+ ----- Method: HtmlFormatter>>anchorLocations (in category 'access') -----
+ anchorLocations
+ 	"return a dictionary mapping lowercase-ed anchor names into the integer positions they are located at in the text"
+ 	^anchorLocations!

Item was added:
+ ----- Method: HtmlFormatter>>baseUrl (in category 'access') -----
+ baseUrl
+ 	"return the base URL for the document we are formatting, if known"
+ 	^baseUrl!

Item was added:
+ ----- Method: HtmlFormatter>>baseUrl: (in category 'access') -----
+ baseUrl: url
+ 	"set the base url.  All relative URLs will be determined relative to it"
+ 	baseUrl _ url.!

Item was added:
+ ----- Method: HtmlFormatter>>browser (in category 'access') -----
+ browser
+ 	"return the browser we are formatting for, or nil if none"
+ 	^browser!

Item was added:
+ ----- Method: HtmlFormatter>>browser: (in category 'access') -----
+ browser: b
+ 	"set what browser we are formatting for"
+ 	browser _ b.!

Item was added:
+ ----- Method: HtmlFormatter>>currentFormData (in category 'forms') -----
+ currentFormData
+ 	"return the current form data, or nil if we aren't inside a form"
+ 	formDatas size > 0 
+ 		ifTrue: [ ^formDatas last ]
+ 		ifFalse: [ ^nil ].!

Item was added:
+ ----- Method: HtmlFormatter>>decreaseBold (in category 'formatting commands') -----
+ decreaseBold
+ 	boldLevel _ boldLevel - 1.
+ 	self setAttributes.!

Item was added:
+ ----- Method: HtmlFormatter>>decreaseIndent (in category 'formatting commands') -----
+ decreaseIndent
+ 	indentLevel _ indentLevel - 1.
+ 	self setAttributes.!

Item was added:
+ ----- Method: HtmlFormatter>>decreaseItalics (in category 'formatting commands') -----
+ decreaseItalics
+ 	italicsLevel _ italicsLevel - 1.
+ 	self setAttributes.!

Item was added:
+ ----- Method: HtmlFormatter>>decreasePreformatted (in category 'formatting commands') -----
+ decreasePreformatted
+ 	preformattedLevel _ preformattedLevel - 1!

Item was added:
+ ----- Method: HtmlFormatter>>decreaseStrike (in category 'formatting commands') -----
+ decreaseStrike
+ 	strikeLevel _ strikeLevel - 1.
+ 	self setAttributes.!

Item was added:
+ ----- Method: HtmlFormatter>>decreaseUnderline (in category 'formatting commands') -----
+ decreaseUnderline
+ 	underlineLevel _ underlineLevel - 1.
+ 	self setAttributes.!

Item was added:
+ ----- Method: HtmlFormatter>>endForm (in category 'forms') -----
+ endForm
+ 	formDatas size > 0 ifTrue: [ 
+ 		formDatas removeLast. ]
+ 	ifFalse: [ self halt: 'HtmlFormatter: ended more forms that started!!?' ].
+ 	self ensureNewlines: 1.!

Item was added:
+ ----- Method: HtmlFormatter>>endHeader: (in category 'formatting commands') -----
+ endHeader: level
+ 	self decreaseBold.
+ 	self ensureNewlines: 2!

Item was added:
+ ----- Method: HtmlFormatter>>endLink: (in category 'formatting commands') -----
+ endLink: url
+ 	urlLink _ nil.
+ 	self setAttributes.!

Item was added:
+ ----- Method: HtmlFormatter>>endListItem (in category 'formatting commands') -----
+ endListItem
+ 	"end a list item"
+ 	self ensureNewlines: 1.!

Item was added:
+ ----- Method: HtmlFormatter>>endOrderedList (in category 'formatting commands') -----
+ endOrderedList
+ 	"end an ordered list"
+ 	listLengths removeLast.
+ 	listTypes removeLast.
+ 	indentLevel _ indentLevel - 1.
+ 	self setAttributes. 
+ 
+ 	self ensureNewlines: 1.
+ 	!

Item was added:
+ ----- Method: HtmlFormatter>>endUnorderedList (in category 'formatting commands') -----
+ endUnorderedList
+ 	"end an unordered list"
+ 	listLengths removeLast.
+ 	listTypes removeLast.
+ 	indentLevel _ indentLevel - 1.
+ 	self setAttributes. 
+ 	
+ 	self ensureNewlines: 1.!

Item was added:
+ ----- Method: HtmlFormatter>>ensureNewlines: (in category 'formatting commands') -----
+ ensureNewlines: number
+ 	"make sure there are at least number preceding newlines"
+ 	number > precedingNewlines ifTrue: [
+ 		(number - precedingNewlines) timesRepeat: [ self addChar: Character cr ] ].!

Item was added:
+ ----- Method: HtmlFormatter>>ensureSpaces: (in category 'formatting commands') -----
+ ensureSpaces: number
+ 	"make sure there are at least number preceding spaces, unless we're at the beginning of a new line"
+ 
+ 	precedingNewlines > 0 ifTrue: [ ^ self ].
+ 
+ 	number > precedingSpaces ifTrue: [
+ 		(number - precedingSpaces) timesRepeat: [ self addChar: Character space ] ].!

Item was added:
+ ----- Method: HtmlFormatter>>hr (in category 'formatting commands') -----
+ hr
+ 	"add an (attempt at a) horizontal rule"
+ 	self ensureNewlines: 1.
+ 	25 timesRepeat: [ self addChar: $- ].
+ 	self ensureNewlines: 1.
+ 	precedingSpaces _ 0.
+ 	precedingNewlines _ 1000.    "pretend it's the top of a new page"!

Item was added:
+ ----- Method: HtmlFormatter>>imageMapNamed: (in category 'image maps') -----
+ imageMapNamed: imageMapName
+ 	^imageMaps detect: [:im | im name asLowercase = imageMapName asLowercase] ifNone: []!

Item was added:
+ ----- Method: HtmlFormatter>>incompleteMorphs (in category 'access') -----
+ incompleteMorphs
+ 	"list of morphs needing to download some more state"
+ 	^incompleteMorphs!

Item was added:
+ ----- Method: HtmlFormatter>>increaseBold (in category 'formatting commands') -----
+ increaseBold
+ 	boldLevel _ boldLevel + 1.
+ 	self setAttributes.!

Item was added:
+ ----- Method: HtmlFormatter>>increaseIndent (in category 'formatting commands') -----
+ increaseIndent
+ 	indentLevel _ indentLevel + 1.
+ 	self setAttributes.!

Item was added:
+ ----- Method: HtmlFormatter>>increaseItalics (in category 'formatting commands') -----
+ increaseItalics
+ 	italicsLevel _ italicsLevel + 1.
+ 	self setAttributes.!

Item was added:
+ ----- Method: HtmlFormatter>>increasePreformatted (in category 'formatting commands') -----
+ increasePreformatted
+ 	preformattedLevel _ preformattedLevel + 1!

Item was added:
+ ----- Method: HtmlFormatter>>increaseStrike (in category 'formatting commands') -----
+ increaseStrike
+ 	strikeLevel _ strikeLevel + 1.
+ 	self setAttributes.!

Item was added:
+ ----- Method: HtmlFormatter>>increaseUnderline (in category 'formatting commands') -----
+ increaseUnderline
+ 	underlineLevel _ underlineLevel + 1.
+ 	self setAttributes.!

Item was added:
+ ----- Method: HtmlFormatter>>initialize (in category 'private-initialization') -----
+ initialize
+ 	outputStream _ AttributedTextStream new.
+ 	preformattedLevel _ 0.
+ 	indentLevel _ boldLevel _ italicsLevel _ underlineLevel _ strikeLevel _ centerLevel _ 0.
+ 	listLengths _ OrderedCollection new.
+ 	listTypes _ OrderedCollection new.
+ 	formDatas _ OrderedCollection new.
+ 	precedingSpaces _ 0.
+ 	precedingNewlines _ 1000.   "more than will ever be asked for"
+ 	morphsToEmbed _ OrderedCollection new.
+ 	incompleteMorphs _ OrderedCollection new.
+ 	anchorLocations _ Dictionary new.
+ 	imageMaps _ OrderedCollection new.!

Item was added:
+ ----- Method: HtmlFormatter>>noteAnchorStart: (in category 'formatting commands') -----
+ noteAnchorStart: anchorName
+ 	"note that an anchor starts at this point in the output"
+ 	anchorLocations at: anchorName asLowercase put: outputStream size!

Item was added:
+ ----- Method: HtmlFormatter>>setAttributes (in category 'private-formatting') -----
+ setAttributes
+ 	"set attributes on the output stream"
+ 	| attribs |
+ 	attribs _ OrderedCollection new.
+ 	indentLevel > 0 ifTrue: [ attribs add: (TextIndent tabs: indentLevel) ].
+ 	boldLevel > 0 ifTrue: [ attribs add: TextEmphasis bold ].
+ 	italicsLevel >  0 ifTrue: [ attribs add: TextEmphasis italic ].
+ 	underlineLevel > 0 ifTrue: [ attribs add: TextEmphasis underlined ].
+ 	strikeLevel > 0 ifTrue: [ attribs add: TextEmphasis struckOut ].
+ 	urlLink isNil ifFalse: [ attribs add: (TextURL new url: urlLink) ].
+ 	outputStream currentAttributes: attribs!

Item was added:
+ ----- Method: HtmlFormatter>>startForm: (in category 'forms') -----
+ startForm: form
+ 	"a form is beginning"
+ 	self ensureNewlines: 1.
+ 	formDatas addLast: (FormInputSet forForm: form  andBrowser: browser).!

Item was added:
+ ----- Method: HtmlFormatter>>startHeader: (in category 'formatting commands') -----
+ startHeader: level
+ 	self ensureNewlines: 3.
+ 	self increaseBold!

Item was added:
+ ----- Method: HtmlFormatter>>startLink: (in category 'formatting commands') -----
+ startLink: url
+ 	urlLink _ url.
+ 	self setAttributes.!

Item was added:
+ ----- Method: HtmlFormatter>>startListItem (in category 'formatting commands') -----
+ startListItem
+ 	"begin a new list item"
+ 	listTypes size = 0 ifTrue: [ ^self ].
+ 	self ensureNewlines: 1.
+ 	listTypes last = #unordered
+ 		ifTrue: [ self addString: '· ' ]
+ 		ifFalse: [ self addString: (listLengths last + 1) printString.
+ 			self addString: '. ' ].
+ 	listLengths at: (listLengths size) put: (listLengths last + 1).!

Item was added:
+ ----- Method: HtmlFormatter>>startOrderedList (in category 'formatting commands') -----
+ startOrderedList
+ 	"begin an ordered list"
+ 	listLengths add: 0.
+ 	listTypes add: #ordered.
+ 	indentLevel _ indentLevel + 1.
+ 	self setAttributes.
+ 	!

Item was added:
+ ----- Method: HtmlFormatter>>startUnorderedList (in category 'formatting commands') -----
+ startUnorderedList
+ 	"begin an unordered list"
+ 	listLengths add: 0.
+ 	listTypes add: #unordered.
+ 	indentLevel _ indentLevel + 1.
+ 	self setAttributes.
+ 	!

Item was added:
+ ----- Method: HtmlFormatter>>text (in category 'formatting') -----
+ text
+ 	| text |
+ 	text _ outputStream contents.
+ 	^text!

Item was added:
+ ----- Method: HtmlFormatter>>textMorph (in category 'formatting') -----
+ textMorph
+ 	| text textMorph |
+ 	text _ outputStream contents.
+ 	textMorph _ TextMorph new contents: text.
+ 	morphsToEmbed do:[ :m | textMorph addMorph: m ].
+ 	^textMorph!

Item was added:
+ HtmlEntity subclass: #HtmlFrame
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlFrame>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	| src |
+ 	src _ self getAttribute: 'src' default: nil.
+ 	formatter ensureNewlines: 1.
+ 	src ifNotNil: [ formatter startLink: src ].
+ 	formatter addString: 'frame '.
+ 	formatter addString: (self name ifNil: ['(unnamed)']).
+ 	src ifNotNil:  [ formatter endLink: src ].
+ 	formatter ensureNewlines: 1.!

Item was added:
+ ----- Method: HtmlFrame>>isFrame (in category 'categorization') -----
+ isFrame
+ 	^true!

Item was added:
+ ----- Method: HtmlFrame>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^false!

Item was added:
+ ----- Method: HtmlFrame>>tagName (in category 'testing') -----
+ tagName
+ 	^'frame'!

Item was added:
+ HtmlEntity subclass: #HtmlFrameSet
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlFrameSet>>isFrameSet (in category 'categorization') -----
+ isFrameSet
+ 	^true!

Item was added:
+ ----- Method: HtmlFrameSet>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^true!

Item was added:
+ ----- Method: HtmlFrameSet>>shouldContain: (in category 'lint') -----
+ shouldContain: anEntity
+ 	^anEntity isFrame or: [ anEntity isFrameSet ]!

Item was added:
+ ----- Method: HtmlFrameSet>>tagName (in category 'testing') -----
+ tagName
+ 	^'frameset'!

Item was added:
+ HtmlEntity subclass: #HtmlHead
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlHead>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isHeadElement or: [ anEntity isComment ]!

Item was added:
+ ----- Method: HtmlHead>>tagName (in category 'testing') -----
+ tagName
+ 	^'head'!

Item was added:
+ ----- Method: HtmlHead>>title (in category 'metainformation') -----
+ title
+ 	"return the title, or nil if there isn't one"
+ 	| te |
+ 	te _ self titleEntity.
+ 	te ifNil: [ ^nil ].
+ 	^te textualContents!

Item was added:
+ ----- Method: HtmlHead>>titleEntity (in category 'metainformation') -----
+ titleEntity
+ 	"return the title entity, or nil if there isn't one"
+ 	contents do: [ :e | e tagName = 'title' ifTrue: [ ^e ] ].
+ 	^nil!

Item was added:
+ HtmlEntity subclass: #HtmlHeadEntity
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlHeadEntity commentStamp: '<historical>' prior: 0!
+ abstract superclass for entities that may appear in the HEAD section!

Item was added:
+ ----- Method: HtmlHeadEntity>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	"head elements are normally just meta-information, and thus don't add anything to the formatter"!

Item was added:
+ ----- Method: HtmlHeadEntity>>isHeadElement (in category 'testing') -----
+ isHeadElement
+ 	^true!

Item was added:
+ HtmlEntity subclass: #HtmlHeader
+ 	instanceVariableNames: 'level'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlHeader>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter startHeader: level.
+ 	super addToFormatter: formatter.
+ 	formatter endHeader: level!

Item was added:
+ ----- Method: HtmlHeader>>initialize: (in category 'private-initialization') -----
+ initialize: aTag
+ 	super initialize: aTag.
+ 	level _ aTag name last digitValue.!

Item was added:
+ ----- Method: HtmlHeader>>isHeader (in category 'testing') -----
+ isHeader
+ 	^true!

Item was added:
+ ----- Method: HtmlHeader>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isTextualEntity!

Item was added:
+ ----- Method: HtmlHeader>>tagName (in category 'testing') -----
+ tagName
+ 	^'h', level printString!

Item was added:
+ HtmlEntity subclass: #HtmlHorizontalRule
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlHorizontalRule>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter hr!

Item was added:
+ ----- Method: HtmlHorizontalRule>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^false!

Item was added:
+ ----- Method: HtmlHorizontalRule>>tagName (in category 'testing') -----
+ tagName
+ 	^'hr'!

Item was added:
+ HtmlSpecialEntity subclass: #HtmlImage
+ 	instanceVariableNames: 'image'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlImage>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	| morph url |
+ 	self src isNil ifTrue: [ ^self ].
+ 	url _ self src.
+ 	formatter baseUrl ifNotNil: [ 
+ 		url _ url asUrlRelativeTo: formatter baseUrl ].
+ 
+ 
+ 	morph _ DownloadingImageMorph new.
+ 	morph defaultExtent: self imageExtent.
+ 	morph altText: self alt.
+ 	morph url: url.
+ 	self imageMapName
+ 		ifNotNil:
+ 			[morph imageMapName: self imageMapName.
+ 			morph formatter: formatter].
+ 
+ 	formatter addIncompleteMorph: morph.!

Item was added:
+ ----- Method: HtmlImage>>alt (in category 'attributes') -----
+ alt
+ 	^(self getAttribute: 'alt') ifNil: ['[image]']!

Item was added:
+ ----- Method: HtmlImage>>downloadState: (in category 'downloading') -----
+ downloadState: baseUrl 
+ 	|  sourceUrl imageSource |
+ 
+ 	image ifNil: [ 
+ 		sourceUrl _ self src.
+ 		sourceUrl ifNotNil: [ 
+ 			imageSource _ HTTPSocket httpGetDocument: (sourceUrl asUrlRelativeTo: baseUrl asUrl) toText.
+ 			imageSource contentType = 'image/gif'  ifTrue: [
+ 				[image _ (GIFReadWriter on: (RWBinaryOrTextStream with: imageSource content) reset binary) nextImage ]
+ 				ifError: [ :a :b |  "could not decode--ignore it"  image _ nil ] ].
+ 			 ] ].
+ !

Item was added:
+ ----- Method: HtmlImage>>imageExtent (in category 'attributes') -----
+ imageExtent
+ 	"the image extent, according to the WIDTH and HEIGHT attributes.  returns nil if either WIDTH or HEIGHT is not specified"
+ 	| widthText heightText |
+ 	widthText _ self getAttribute: 'width' ifAbsent: [ ^nil ].
+ 	heightText _ self getAttribute: 'height' ifAbsent: [ ^nil ].
+ 	^ [ widthText asNumber @ heightText asNumber ] ifError: [ :a :b | nil ]!

Item was added:
+ ----- Method: HtmlImage>>imageMapName (in category 'attributes') -----
+ imageMapName
+ 	| imageMapName |
+ 	(imageMapName _ self getAttribute: 'usemap')
+ 		ifNil: [^nil].
+ 	imageMapName first = $#
+ 		ifTrue: [imageMapName _ imageMapName copyFrom: 2 to: imageMapName size].
+ 	^imageMapName!

Item was added:
+ ----- Method: HtmlImage>>initialize: (in category 'initializing') -----
+ initialize: aTag	
+ 	super initialize: aTag.
+ !

Item was added:
+ ----- Method: HtmlImage>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^false!

Item was added:
+ ----- Method: HtmlImage>>src (in category 'attributes') -----
+ src
+ 	^self getAttribute: 'src' default: nil!

Item was added:
+ ----- Method: HtmlImage>>tagName (in category 'testing') -----
+ tagName
+ 	^'img'!

Item was added:
+ HtmlFormEntity subclass: #HtmlInput
+ 	instanceVariableNames: 'value'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlInput commentStamp: '<historical>' prior: 0!
+ result of an <input> tag!

Item was added:
+ ----- Method: HtmlInput>>addCheckBoxButtonToFormatter: (in category 'formatting') -----
+ addCheckBoxButtonToFormatter: formatter
+ 	| name formData checked button buttonInput |
+ 
+ 	"dig up relevant attributes"
+ 	name _ self getAttribute: 'name'.
+ 	name ifNil: [ ^self ].
+ 	value _ self getAttribute: 'value'.
+ 	value ifNil: [ ^value ].
+ 	
+ 	formData _ formatter currentFormData.
+ 	formData ifNil:  [ ^self ].
+ 
+ 	checked _ (self getAttribute: 'checked') isNil not.
+ 
+ 	"set up the form input"
+ 	buttonInput _ ToggleButtonInput name: name value: value checkedByDefault: checked.
+ 	formData addInput: buttonInput.
+ 
+ 	"create the actual button"
+ 	button _ UpdatingThreePhaseButtonMorph checkBox.
+ 	button target: buttonInput;
+ 		getSelector: #pressed;
+ 		actionSelector: #toggle.
+ 	buttonInput button: button.
+ 	formatter addMorph: button.
+ 
+ 
+ !

Item was added:
+ ----- Method: HtmlInput>>addFileInputToFormatter: (in category 'formatting') -----
+ addFileInputToFormatter: formatter
+ 	"is it a submit button?"
+ 	| inputMorph size fileInput |
+ 	inputMorph _ PluggableTextMorph on: StringHolder new text: #contents accept: #acceptContents:.
+ 	size _ (self getAttribute: 'size' default: '12') asNumber.
+ 	inputMorph extent: (size*10 at 20).
+ 	fileInput _ FileInput name: self name textMorph: inputMorph.
+ 	formatter addMorph: inputMorph;
+ 		addMorph: ((PluggableButtonMorph on: fileInput getState: nil action: #browse)
+ 				label: 'Browse').
+ 	formatter currentFormData addInput: fileInput!

Item was added:
+ ----- Method: HtmlInput>>addImageButtonToFormatter: (in category 'formatting') -----
+ addImageButtonToFormatter: formatter
+ 	"is it a submit button?"
+ 	| formData imageUrl morph |
+ 	(imageUrl _ self getAttribute: 'src') ifNil: [^self].
+ 	formatter baseUrl
+ 		ifNotNil: [imageUrl _ imageUrl asUrlRelativeTo: formatter baseUrl].
+ 
+ 	morph _ DownloadingImageMorph new.
+ 	morph defaultExtent: self imageExtent.
+ 	morph altText: self alt.
+ 	morph url: imageUrl.
+ 
+ 	value _ self getAttribute: 'name' default: 'Submit'.
+ 	formData _ formatter currentFormData.
+ 	morph
+ 		on: #mouseUp
+ 		send: #mouseUpFormData:event:linkMorph:
+ 		to: self
+ 		withValue: formData.
+ 	formatter addIncompleteMorph: morph
+ !

Item was added:
+ ----- Method: HtmlInput>>addRadioButtonToFormatter: (in category 'formatting') -----
+ addRadioButtonToFormatter: formatter
+ 	| name formData checked buttonSet button buttonInput |
+ 
+ 	"dig up relevant attributes"
+ 	name _ self getAttribute: 'name'.
+ 	name ifNil: [ ^self ].
+ 	value _ self getAttribute: 'value'.
+ 	value ifNil: [ ^value ].
+ 	
+ 	formData _ formatter currentFormData.
+ 	formData ifNil:  [ ^self ].
+ 
+ 	checked _ self getAttribute: 'checked'.
+ 
+ 
+ 	"find or create the set of buttons with our same name"
+ 	buttonSet _ formData inputs detect: [ :i | i isRadioButtonSetInput and: [ i name = name ] ] ifNone: [ nil ].
+ 	buttonSet ifNil: [ 
+ 		"create a new button set"
+ 		buttonSet _ RadioButtonSetInput name: name.
+ 		formData addInput: buttonSet. ].
+ 
+ 	"set up the form input"
+ 	buttonInput _ RadioButtonInput  inputSet: buttonSet value: value.
+ 	buttonSet addInput: buttonInput.
+ 	checked ifNotNil: [
+ 		buttonSet  defaultButton: buttonInput ].
+ 
+ 	"create the actual button"
+ 	button _ UpdatingThreePhaseButtonMorph radioButton.
+ 	button target: buttonInput;
+ 		getSelector: #pressed;
+ 		actionSelector: #toggle.
+ 	buttonInput button: button.
+ 	formatter addMorph: button.
+ 
+ 
+ !

Item was added:
+ ----- Method: HtmlInput>>addTextInputToFormatter: (in category 'formatting') -----
+ addTextInputToFormatter: formatter
+ 	"is it a submit button?"
+ 	| inputMorph size |
+ 	inputMorph _ PluggableTextMorph on: StringHolder new text: #contents accept: #acceptContents:.
+ 	self type = 'password'
+ 		ifTrue: [inputMorph font: (StrikeFont passwordFontSize: 12)].
+ 	size _ (self getAttribute: 'size' default: '12') asNumber.
+ 	inputMorph extent: (size*10 at 20).
+ 	formatter addMorph: inputMorph.
+ 	formatter currentFormData addInput:
+ 		(TextInput name: self name defaultValue: self defaultValue  textMorph: inputMorph).!

Item was added:
+ ----- Method: HtmlInput>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter currentFormData ifNil: [
+ 		"not in a form.  It's bogus HTML but try to survive"
+ 		^self ].
+ 
+ 	"is it a submit button?"
+ 	self type = 'submit' ifTrue: [
+ 		formatter addMorph: ((PluggableButtonMorph on: formatter currentFormData getState: nil action: #submit) label: (self getAttribute: 'value' default: 'Submit')).
+ 		^self ].
+ 
+ 	self type = 'image'
+ 		ifTrue: [^self addImageButtonToFormatter: formatter].
+ 
+ 	(self type = 'text' or: [self type = 'password'])
+ 		ifTrue: [^self addTextInputToFormatter: formatter].
+ 
+ 	self type = 'hidden' ifTrue: [
+ 		formatter currentFormData addInput: (HiddenInput name: self name  value: self defaultValue).
+ 		^self ].
+ 
+ 	self type = 'radio' ifTrue: [ 
+ 		^self addRadioButtonToFormatter: formatter ].
+ 
+ 	self type = 'checkbox' ifTrue: [ 
+ 		^self addCheckBoxButtonToFormatter: formatter ].
+ 
+ 	self type = 'file' ifTrue: [ 
+ 		^self addFileInputToFormatter: formatter ].
+ 
+ 	formatter addString: '[form input of type: ', self type, ']'.!

Item was added:
+ ----- Method: HtmlInput>>defaultValue (in category 'attributes') -----
+ defaultValue
+ 	^(self getAttribute: 'value' default: '') replaceHtmlCharRefs!

Item was added:
+ ----- Method: HtmlInput>>imageExtent (in category 'attributes') -----
+ imageExtent
+ 	"the image extent, according to the WIDTH and HEIGHT attributes.  returns nil if either WIDTH or HEIGHT is not specified"
+ 	| widthText heightText |
+ 	widthText _ self getAttribute: 'width' ifAbsent: [ ^nil ].
+ 	heightText _ self getAttribute: 'height' ifAbsent: [ ^nil ].
+ 	^ widthText asNumber @ heightText asNumber!

Item was added:
+ ----- Method: HtmlInput>>isTextualEntity (in category 'testing') -----
+ isTextualEntity
+ 	^true!

Item was added:
+ ----- Method: HtmlInput>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^false!

Item was added:
+ ----- Method: HtmlInput>>mouseUpEvent:linkMorph:formData: (in category 'morphic') -----
+ mouseUpEvent: arg1 linkMorph: arg2 formData: arg3
+ 	"Reorder the arguments for existing event handlers"
+ 	(arg3 isMorph and:[arg3 eventHandler notNil]) ifTrue:[arg3 eventHandler fixReversedValueMessages].
+ 	^self mouseUpFormData: arg1 event: arg2 linkMorph: arg3!

Item was added:
+ ----- Method: HtmlInput>>mouseUpFormData:event:linkMorph: (in category 'morphic') -----
+ mouseUpFormData: formData event: event linkMorph: linkMorph
+ 	| aPoint |
+ 	aPoint _ event cursorPoint - linkMorph topLeft.
+ 	formData addInput: (HiddenInput name: (value, '.x') value: aPoint x asInteger asString).
+ 	formData addInput: (HiddenInput name: (value, '.y') value: aPoint y asInteger asString).
+ 	formData submit!

Item was added:
+ ----- Method: HtmlInput>>suppliesInput (in category 'testing') -----
+ suppliesInput
+ 	"whether we actually have input to supply"
+ 	self type = 'text' ifTrue: [ ^true ].
+ 	^false!

Item was added:
+ ----- Method: HtmlInput>>tagName (in category 'testing') -----
+ tagName
+ 	^'input'!

Item was added:
+ ----- Method: HtmlInput>>type (in category 'attributes') -----
+ type
+ 	^(self getAttribute: 'type' default: 'text') asLowercase!

Item was added:
+ HtmlFontChangeEntity subclass: #HtmlItalicsEntity
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlItalicsEntity commentStamp: '<historical>' prior: 0!
+ an entity which displays its contents in italics!

Item was added:
+ ----- Method: HtmlItalicsEntity>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter increaseItalics.
+ 	super addToFormatter: formatter.	
+ 	formatter decreaseItalics.!

Item was added:
+ HtmlBlockEntity subclass: #HtmlList
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlList>>mayContain: (in category 'testing') -----
+ mayContain: anElement
+ 	"lists may only contain LI elements"
+ 	"^anElement isListItem"
+ 
+ 	"except that people write some sucky HTML out there!!!!  well, let's assume they always put the end tag.  Much safer assumption than that they only put list-items in their lists"
+ 	^true!

Item was added:
+ ----- Method: HtmlList>>shouldContain: (in category 'testing') -----
+ shouldContain: anEntity
+ 	^anEntity isListItem!

Item was added:
+ HtmlEntity subclass: #HtmlListItem
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlListItem>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter startListItem.
+ 	super addToFormatter: formatter.
+ 	formatter endListItem.!

Item was added:
+ ----- Method: HtmlListItem>>isListItem (in category 'testing') -----
+ isListItem
+ 	^true!

Item was added:
+ ----- Method: HtmlListItem>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isBlockEntity or: [ anEntity isTextualEntity ]!

Item was added:
+ ----- Method: HtmlListItem>>tagName (in category 'testing') -----
+ tagName
+ 	^'li'!

Item was added:
+ HtmlEntity subclass: #HtmlMap
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlMap>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	super addToFormatter: formatter.
+ 	formatter addImageMap: self!

Item was added:
+ ----- Method: HtmlMap>>buildImageMapForImage:andBrowser: (in category 'morphic') -----
+ buildImageMapForImage: imageMorph andBrowser: browser
+ 	| areaMorph |
+ 	contents do: [:area |
+ 		(area isArea
+ 		and: [(areaMorph _ area linkMorphForMap: self andBrowser: browser) isNil not])
+ 			ifTrue: [imageMorph addMorph: areaMorph]].
+ 	^imageMorph!

Item was added:
+ ----- Method: HtmlMap>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isArea!

Item was added:
+ ----- Method: HtmlMap>>mouseUpBrowserAndUrl:event:linkMorph: (in category 'morphic') -----
+ mouseUpBrowserAndUrl: browserAndUrl event: event linkMorph: linkMorph
+ 	"this is an image map area, just follow the link"
+ 	| browser url |
+ 	browser _ browserAndUrl first.
+ 	url _ browserAndUrl second.
+ 	browser jumpToUrl: url!

Item was added:
+ ----- Method: HtmlMap>>mouseUpEvent:linkMorph:browserAndUrl: (in category 'morphic') -----
+ mouseUpEvent: arg1 linkMorph: arg2 browserAndUrl: arg3
+ 	"Reorder the arguments for existing event handlers"
+ 	(arg3 isMorph and:[arg3 eventHandler notNil]) ifTrue:[arg3 eventHandler fixReversedValueMessages].
+ 	^self mouseUpBrowserAndUrl: arg1 event: arg2 linkMorph: arg3!

Item was added:
+ ----- Method: HtmlMap>>name (in category 'accessing') -----
+ name
+ 	^self getAttribute: 'name'!

Item was added:
+ ----- Method: HtmlMap>>tagName (in category 'testing') -----
+ tagName
+ 	^'map'!

Item was added:
+ HtmlHeadEntity subclass: #HtmlMeta
+ 	instanceVariableNames: 'theTag'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlMeta commentStamp: '<historical>' prior: 0!
+ some result of a meta tag; unimplemented so far!

Item was added:
+ ----- Method: HtmlMeta>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	| httpEquiv |
+ 	httpEquiv _ self getAttribute: 'http-equiv'.
+ 	httpEquiv ifNil: [ ^self ].
+ 	httpEquiv asLowercase = 'refresh' ifTrue: [
+ 		formatter addString: '{refresh: ', (self getAttribute:  'content' default: ''), '}' ].!

Item was added:
+ ----- Method: HtmlMeta>>initialize: (in category 'initialization') -----
+ initialize: aTag
+ 	super initialize: aTag.
+ 	theTag _ aTag.!

Item was added:
+ ----- Method: HtmlMeta>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^false!

Item was added:
+ ----- Method: HtmlMeta>>printOn:indent: (in category 'printing') -----
+ printOn: aStream indent: indent
+ 	indent timesRepeat: [ aStream space ].
+ 	aStream nextPutAll: 'meta: '.
+ 	theTag printOn: aStream.
+ 	aStream cr.!

Item was added:
+ ----- Method: HtmlMeta>>tagName (in category 'testing') -----
+ tagName
+ 	^'meta'!

Item was added:
+ HtmlSpecialEntity subclass: #HtmlNoEmbed
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlNoEmbed>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: aFormatter
+ 	"Check if the last incomplete morph has the property #embedded set.
+ 	If so, assume that the last <EMBED> tag has been handled."
+ 	| morphs |
+ 	morphs _ aFormatter incompleteMorphs.
+ 	(morphs isEmpty not and:[(morphs last valueOfProperty: #embedded) == true])
+ 		ifTrue:[^self].
+ 	"If not handled do the usual stuff"
+ 	^super addToFormatter: aFormatter!

Item was added:
+ ----- Method: HtmlNoEmbed>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isTextualEntity!

Item was added:
+ ----- Method: HtmlNoEmbed>>tagName (in category 'testing') -----
+ tagName
+ 	^'noembed'!

Item was added:
+ HtmlFormEntity subclass: #HtmlOption
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlOption>>isOption (in category 'testing') -----
+ isOption
+ 	^true!

Item was added:
+ ----- Method: HtmlOption>>label (in category 'attributes') -----
+ label
+ 	"label to be displayed for this morph"
+ 	^self getAttribute: 'label' ifAbsent: [self textualContents]!

Item was added:
+ ----- Method: HtmlOption>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isTextualEntity!

Item was added:
+ ----- Method: HtmlOption>>tagName (in category 'testing') -----
+ tagName
+ 	^'option'!

Item was added:
+ ----- Method: HtmlOption>>value (in category 'attributes') -----
+ value
+ 	"value to pass if this option is selected"
+ 	^self getAttribute: 'value' default: '(unspecified)'!

Item was added:
+ HtmlFormEntity subclass: #HtmlOptionGroup
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlOptionGroup>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isOption!

Item was added:
+ ----- Method: HtmlOptionGroup>>tagName (in category 'testing') -----
+ tagName
+ 	^'optgroup'!

Item was added:
+ HtmlList subclass: #HtmlOrderedList
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlOrderedList>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter startOrderedList.
+ 	super addToFormatter: formatter.
+ 	formatter endOrderedList.!

Item was added:
+ ----- Method: HtmlOrderedList>>tagName (in category 'testing') -----
+ tagName
+ 	^'ol'!

Item was added:
+ HtmlEntity subclass: #HtmlParagraph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlParagraph>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter ensureNewlines: 2.
+ 	super addToFormatter: formatter.!

Item was added:
+ ----- Method: HtmlParagraph>>isBlockEntity (in category 'testing') -----
+ isBlockEntity
+ 	^true!

Item was added:
+ ----- Method: HtmlParagraph>>isParagraph (in category 'testing') -----
+ isParagraph
+ 	^true!

Item was added:
+ ----- Method: HtmlParagraph>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isTextualEntity!

Item was added:
+ ----- Method: HtmlParagraph>>tagName (in category 'testing') -----
+ tagName
+ 	^'p'!

Item was added:
+ Object subclass: #HtmlParser
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser'!
+ 
+ !HtmlParser commentStamp: '<historical>' prior: 0!
+ parses a stream of HtmlToken's into an HtmlDocument.  All token become an entity of some sort in the resulting document; some things are left only as comments, though.!

Item was added:
+ ----- Method: HtmlParser class>>example1 (in category 'example') -----
+ example1
+ 	"HtmlParser example1"
+ 	| input |
+ 	input _ ReadStream on: 
+ '<html>
+ <head>
+ <title>The Gate of Chaos</title>
+ </head>
+ 
+ <body>
+ 
+ <h1>Chaos</h1>
+ 
+ 
+ 
+ <h2>Into the Maelstrom</h2>
+ Direction is useless in the ever-changing Maelstrom.  However,
+ if you wander with purpose, you might be able to find....
+ <ul>
+ <li><a href="/cgi-bin/w">see who''s logged in</a>
+ <li><a href="/Telnet/connect.html">log in, if you (oooh) have an account</a>
+ <li><a href="http://chaos.resnet.gatech.edu:9000/sw">The Chaos Swiki</a>--scribble on chaos
+ <li>the original <a href="/cgi-bin/guestlog-print">Visitor Sands</a>
+ <li>my old <a href="rant.html">Rant Page</a>
+ <li>neverending <a href="/cgi-bin/bread">poll</a>: do you have an opinion on bread?
+ <li>a <a href="http://www.cc.gatech.edu/~lex/linux.html">Linux page</a>-- free UNIX for PC''s!!
+ <li><a href="english.au">Hear Linus Himself speak!!!!</a>
+ <li><a href="/doc/">some docs on all kinds of computer stuff</a>
+ </ul>
+ 
+ <hr>
+ 
+ 
+ <h2>Paths of Retreat</h2>
+ Several commonly travelled ways have left paths leading 
+ <em>away</em> from the maelstrom, too:
+ <p>
+ <ul>
+ <li><a href="friends.html">Friends of Chaos</a>
+ <li><a href="http://www.apache.org/">The <em>Apache</em> home page</a> -- 
+         <em>Chaos</em>''s WWW server!!
+ <li><a href="http://www.ee.umanitoba.ca/~djc/personal/notscape.html">
+ Notscape</a>
+ 
+ the <a href="http://www.eskimo.com/%7Eirving/anti-ns/">Anti-Netscape
+ Page</a> -- fight the tyranny!!
+ </ul>
+ 
+ <hr>
+ <a href="/analog/usage.html">usage stats</a> for this server
+ 
+ <hr>
+ <a href="http://www.eff.org/blueribbon.html"><img src="blueribbon.gif" alt="[blue ribbon campaign]"></a>
+ <a href="http://www.ee.umanitoba.ca/~djc/personal/notscape.html">
+ <img src="notscape.gif" alt="[NOTscape]">
+ </a>
+ <a href="http://www.anybrowser.org/campaign/">
+ <img src="anybrowser3.gif" alt="[Best Viewed With Any Browser]"></a>
+ </body>
+ </html>'.
+ 
+ 	^HtmlParser parse: input!

Item was added:
+ ----- Method: HtmlParser class>>parse: (in category 'parsing') -----
+ parse: aStream
+ 	^self parseTokens: (HtmlTokenizer on: aStream)
+ !

Item was added:
+ ----- Method: HtmlParser class>>parseTokens: (in category 'parsing') -----
+ parseTokens: tokenStream
+ 	|  entityStack document head token matchesAnything entity body |
+ 
+ 	entityStack _ OrderedCollection new.
+ 
+ 	"set up initial stack"
+ 	document _ HtmlDocument new.
+ 	entityStack add: document.
+ 	
+ 	head _ HtmlHead new.
+ 	document addEntity: head.
+ 	entityStack add: head.
+ 
+ 
+ 	"go through the tokens, one by one"
+ 	[ token _ tokenStream next.  token = nil ] whileFalse: [
+ 		(token isTag and: [ token isNegated ]) ifTrue: [
+ 			"a negated token"
+ 			(token name ~= 'html' and: [ token name ~= 'body' ]) ifTrue: [
+ 				"see if it matches anything in the stack"
+ 				matchesAnything _ (entityStack detect: [ :e | e tagName = token name ] ifNone: [ nil ]) isNil not.
+ 				matchesAnything ifTrue: [
+ 					"pop the stack until we find the right one"
+ 					[ entityStack last tagName ~= token name ] whileTrue: [ entityStack removeLast ].
+ 					entityStack removeLast.
+ 				]. ] ]
+ 		ifFalse: [
+ 			"not a negated token.  it makes its own entity"
+ 			token isComment ifTrue: [
+ 				entity _ HtmlCommentEntity new initializeWithText: token source.
+ 			].
+ 			token isText ifTrue: [
+ 				entity _ HtmlTextEntity new text: token text.
+ 				(((entityStack last shouldContain: entity) not) and: 
+ 					[ token source isAllSeparators ]) ifTrue: [
+ 					"blank text may never cause the stack to back up"
+ 					entity _ HtmlCommentEntity new initializeWithText: token source ].
+ 			].
+ 			token isTag ifTrue: [
+ 				entity _ token entityFor.
+ 				entity = nil ifTrue: [ entity _ HtmlCommentEntity new initializeWithText: token source ] ].
+ 			(token name = 'body')
+ 				ifTrue: [body ifNotNil: [document removeEntity: body].
+ 					body _ HtmlBody new initialize: token.
+ 					document addEntity: body.
+ 					entityStack add: body].
+ 
+ 			entity = nil ifTrue: [ self error: 'could not deal with this token' ].
+ 
+ 			entity isComment ifTrue: [
+ 				"just stick it anywhere"
+ 				entityStack last addEntity: entity ]
+ 			ifFalse: [
+ 				"only put it in something that is valid"
+ 				[ entityStack last mayContain: entity ] 
+ 					whileFalse: [ entityStack removeLast ].
+ 
+ 				"if we have left the head, create a body"					
+ 				(entityStack size < 2 and: [body isNil]) ifTrue: [
+ 					body _ HtmlBody new.
+ 					document addEntity: body.
+ 					entityStack add: body  ].
+ 
+ 				"add the entity"
+ 				entityStack last addEntity: entity.
+ 				entityStack addLast: entity.
+ 			].
+ 		]].
+ 
+ 	body == nil ifTrue: [
+ 		"add an empty body"
+ 		body _ HtmlBody new.
+ 		document addEntity: body ].
+ 
+ 	document parsingFinished.
+ 
+ 	^document!

Item was added:
+ HtmlEntity subclass: #HtmlPreformattedRegion
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlPreformattedRegion>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter ensureNewlines: 1.
+ 	formatter increasePreformatted.
+ 	super addToFormatter: formatter.
+ 	formatter decreasePreformatted.
+ 	formatter ensureNewlines: 1.!

Item was added:
+ ----- Method: HtmlPreformattedRegion>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^true!

Item was added:
+ ----- Method: HtmlPreformattedRegion>>shouldContain: (in category 'lint') -----
+ shouldContain: anEntity
+ 	^anEntity isTextualEntity!

Item was added:
+ ----- Method: HtmlPreformattedRegion>>tagName (in category 'testing') -----
+ tagName
+ 	^'pre'!

Item was added:
+ HtmlFormEntity subclass: #HtmlSelect
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlSelect>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	| options defaultOption listMorph names size valueHolder |
+ 	formatter currentFormData ifNil: [
+ 		"not in a form.  It's bogus HTML but try to survive"
+ 		^self ].
+ 
+ 	names _ OrderedCollection new.
+ 	options _ OrderedCollection new.
+ 	defaultOption _ nil.
+ 
+ 	(self getAttribute: 'multiple') ifNotNil: [
+ 		self flag: #incomplete.
+ 		formatter addString: '[M option list]'.
+ 		^self ].
+ 
+ 	contents do: [ :c |  c isOption ifTrue: [
+ 		names add: c value.
+ 		options add: c label withBlanksCondensed.
+ 		(c getAttribute: 'selected') ifNotNil: [ defaultOption _ c label ] ] ].
+ 
+ 	contents isEmpty ifTrue: [ ^self ].
+ 
+ 	defaultOption ifNil: [ defaultOption _ options first ].
+ 
+ 	size _ (self getAttribute: 'size' default: '1') asNumber.
+ 	size = 1
+ 		ifTrue: [listMorph _ DropDownChoiceMorph new initialize; contents: defaultOption.
+ 			listMorph items: options; target: nil; getItemsSelector: nil;
+ 				maxExtent: options; border: #useBorder]
+ 		ifFalse: [valueHolder _ ValueHolder new contents: (contents indexOf: defaultOption).
+ 			listMorph _ PluggableListMorph on: valueHolder list: nil
+ 				selected: #contents  changeSelected: #contents:.
+ 			listMorph list: options.
+ 			listMorph extent: ((listMorph extent x) @ (listMorph scrollDeltaHeight * size))].
+ 
+ 	formatter addMorph: listMorph.
+ 
+ 	formatter currentFormData addInput:
+ 		(SelectionInput  name: self name  defaultValue: defaultOption
+ 			list: listMorph  values: names asArray)!

Item was added:
+ ----- Method: HtmlSelect>>isTextualEntity (in category 'testing') -----
+ isTextualEntity
+ 	^true!

Item was added:
+ ----- Method: HtmlSelect>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^true  "end tag required"!

Item was added:
+ ----- Method: HtmlSelect>>tagName (in category 'testing') -----
+ tagName
+ 	^'select'!

Item was added:
+ HtmlFontChangeEntity subclass: #HtmlSmallerFontEntity
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlSmallerFontEntity commentStamp: '<historical>' prior: 0!
+ supposedly decreases the font size its constituents are displayed in!

Item was added:
+ HtmlTextualEntity subclass: #HtmlSpecialEntity
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ HtmlFontChangeEntity subclass: #HtmlStrikeEntity
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlStrikeEntity commentStamp: '<historical>' prior: 0!
+ the contents should be displayed struck-through!

Item was added:
+ ----- Method: HtmlStrikeEntity>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter increaseStrike.
+ 	super addToFormatter: formatter.
+ 	formatter decreaseStrike.!

Item was added:
+ HtmlHeadEntity subclass: #HtmlStyle
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlStyle>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isTextualEntity!

Item was added:
+ ----- Method: HtmlStyle>>tagName (in category 'testing') -----
+ tagName
+ 	^'style'!

Item was added:
+ HtmlFontChangeEntity subclass: #HtmlSubscript
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlSubscript commentStamp: '<historical>' prior: 0!
+ an entity to be displayed as a subscript!

Item was added:
+ HtmlFontChangeEntity subclass: #HtmlSuperscript
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlSuperscript commentStamp: '<historical>' prior: 0!
+ an entity whose contents are to be displayed as a superscript!

Item was added:
+ HtmlEntity subclass: #HtmlTable
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlTable>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter ensureNewlines: 1.
+ 	super addToFormatter: formatter.
+ 	formatter ensureNewlines: 1.!

Item was added:
+ ----- Method: HtmlTable>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isTableRow!

Item was added:
+ ----- Method: HtmlTable>>tagName (in category 'testing') -----
+ tagName
+ 	^'table'!

Item was added:
+ HtmlEntity subclass: #HtmlTableDataItem
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlTableDataItem>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	super addToFormatter: formatter.
+ 	formatter ensureSpaces: 1.!

Item was added:
+ ----- Method: HtmlTableDataItem>>isTableDataItem (in category 'testing') -----
+ isTableDataItem
+ 	^true!

Item was added:
+ ----- Method: HtmlTableDataItem>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isTextualEntity or: [ anEntity isBlockEntity or: [ anEntity isHeader ] ]!

Item was added:
+ ----- Method: HtmlTableDataItem>>tagName (in category 'testing') -----
+ tagName
+ 	^'td'!

Item was added:
+ HtmlTableDataItem subclass: #HtmlTableHeader
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlTableHeader commentStamp: '<historical>' prior: 0!
+ a TH tag.  Currently treated the same as a TD!

Item was added:
+ ----- Method: HtmlTableHeader>>tagName (in category 'accessing') -----
+ tagName
+ 	^'th'!

Item was added:
+ HtmlEntity subclass: #HtmlTableRow
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlTableRow>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	super addToFormatter: formatter.
+ 	formatter ensureNewlines: 1.!

Item was added:
+ ----- Method: HtmlTableRow>>asArrayOfData (in category 'accessing') -----
+ asArrayOfData
+ 	"Return an Array of the table row, removing all html.  This is only the text and numbers that the user would see on a web page.  Remove all comments and formatting."
+ 
+ 	| cc |
+ 	cc _ contents select: [:ent | ent isTableDataItem].
+ 	^ cc collect: [:ent | ent asHtml asUnHtml withBlanksTrimmed]
+ 		"for now, leave the numbers as strings.  User will know which to convert"!

Item was added:
+ ----- Method: HtmlTableRow>>isTableRow (in category 'testing') -----
+ isTableRow
+ 	^true!

Item was added:
+ ----- Method: HtmlTableRow>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isTableDataItem!

Item was added:
+ ----- Method: HtmlTableRow>>tagName (in category 'testing') -----
+ tagName
+ 	^'tr'!

Item was added:
+ HtmlToken subclass: #HtmlTag
+ 	instanceVariableNames: 'isNegated name attribs'
+ 	classVariableNames: 'EntityClasses'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Tokenizer'!
+ 
+ !HtmlTag commentStamp: '<historical>' prior: 0!
+ An HTML tag, eg <a href="foo.html">!

Item was added:
+ ----- Method: HtmlTag class>>entityClasses (in category 'parser support') -----
+ entityClasses
+ 	"a Dictionary mapping tag names into the correct entity class"
+ 	"EntityClasses _ nil"
+ 
+ 	EntityClasses isNil ifFalse: [ ^EntityClasses ].
+ 
+ 	EntityClasses _ Dictionary new.
+ 
+ 	#( 
+ 		frameset	HtmlFrame
+ 		frame	HtmlFrame
+ 
+ 		title		HtmlTitle
+ 		style	HtmlStyle
+ 		meta	HtmlMeta
+ 
+ 		p		HtmlParagraph
+ 		form	HtmlForm
+ 		blockquote	HtmlBlockQuote
+ 
+ 		input	HtmlInput
+ 		textarea	HtmlTextArea
+ 		select	HtmlSelect
+ 		optgroup	HtmlOptionGroup
+ 		option		HtmlOption
+ 
+ 		img		HtmlImage
+ 		embed	HtmlEmbedded
+ 		noembed	HtmlNoEmbed
+ 		a		HtmlAnchor
+ 		br		HtmlBreak
+ 
+ 		map	HtmlMap
+ 		area	HtmlArea
+ 
+ 		li		HtmlListItem
+ 		dd		HtmlDefinitionDefinition
+ 		dt		HtmlDefinitionTerm
+ 
+ 		ol		HtmlOrderedList
+ 		ul		HtmlUnorderedList
+ 		dl		HtmlDefinitionList
+ 
+ 		h1		HtmlHeader
+ 		h2		HtmlHeader
+ 		h3		HtmlHeader
+ 		h4		HtmlHeader
+ 		h5		HtmlHeader
+ 		h6		HtmlHeader
+ 
+ 		hr		HtmlHorizontalRule
+ 
+ 		strong	HtmlBoldEntity
+ 		b		HtmlBoldEntity
+ 
+ 		em		HtmlItalicsEntity
+ 		i		HtmlItalicsEntity
+ 		dfn 	HtmlItalicsEntity
+ 
+ 		u		HtmlUnderlineEntity 
+ 
+ 		tt		HtmlFixedWidthEntity
+ 		kbd		HtmlFixedWidthEntity		
+ 
+ 		strike	HtmlStrikeEntity
+ 
+ 		big		HtmlBiggerFontEntity
+ 		small	HtmlSmallerFontEntity
+ 
+ 		sub		HtmlSubscript
+ 		sup		HtmlSuperscript
+ 
+ 		font	HtmlFontEntity
+ 
+ 		pre		HtmlPreformattedRegion
+  
+ 		table	HtmlTable
+ 		tr		HtmlTableRow
+ 		td		HtmlTableDataItem 
+ 		th		HtmlTableHeader
+ 		) pairsDo: [ 
+ 			:tagName :className |
+ 			EntityClasses at: tagName asString put: (Smalltalk at: className) ].
+ 
+ 	^EntityClasses !

Item was added:
+ ----- Method: HtmlTag class>>initialize (in category 'parser support') -----
+ initialize
+ 	"HtmlTag initialize"
+ 	EntityClasses _ nil.!

Item was added:
+ ----- Method: HtmlTag class>>source:name:negated:attribs: (in category 'instance creation') -----
+ source: source0  name: name0  negated: negated0 attribs: attribs0
+ 	^(super forSource: source0) name: name0 negated: negated0 attribs: attribs0!

Item was added:
+ ----- Method: HtmlTag>>attribs (in category 'access') -----
+ attribs
+ 	"return a dictionary mapping attribute names (in lowercase) to their values"
+ 	^attribs
+ !

Item was added:
+ ----- Method: HtmlTag>>entityFor (in category 'parser support') -----
+ entityFor
+ 	"return an empty entity corresponding to this tag"
+ 	| eClass |
+ 	eClass _ self class entityClasses at: name ifAbsent: [ ^nil ].
+ 	^eClass forTag: self !

Item was added:
+ ----- Method: HtmlTag>>isNegated (in category 'access') -----
+ isNegated
+ 	^isNegated!

Item was added:
+ ----- Method: HtmlTag>>isTag (in category 'properties') -----
+ isTag
+ 	^true!

Item was added:
+ ----- Method: HtmlTag>>name (in category 'access') -----
+ name
+ 	"return the basic kind of tag, in lowercase"
+ 	^name
+ !

Item was added:
+ ----- Method: HtmlTag>>name:negated:attribs: (in category 'private-initialization') -----
+ name: name0  negated: isNegated0 attribs: attribs0
+ 	"initialize from the given attributes"
+ 	name _ name0.
+ 	isNegated _ isNegated0.
+ 	attribs _ attribs0 ifNil: [Dictionary new]!

Item was added:
+ HtmlToken subclass: #HtmlText
+ 	instanceVariableNames: 'text'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Tokenizer'!
+ 
+ !HtmlText commentStamp: '<historical>' prior: 0!
+ A sequence of text without any tags in it.  &sp; style characters have been replaced by their actual values. !

Item was added:
+ ----- Method: HtmlText>>addToFormatter: (in category 'formatter') -----
+ addToFormatter: aFormatter
+ 	"add ourself to a formatter"
+ 	aFormatter addText: source!

Item was added:
+ ----- Method: HtmlText>>initialize: (in category 'private-initialization') -----
+ initialize: source0
+ 	super initialize: source0.
+ 	self text: source0 replaceHtmlCharRefs.!

Item was added:
+ ----- Method: HtmlText>>isText (in category 'properties') -----
+ isText
+ 	^true!

Item was added:
+ ----- Method: HtmlText>>text (in category 'access') -----
+ text
+ 	^text
+ !

Item was added:
+ ----- Method: HtmlText>>text: (in category 'private-initialization') -----
+ text: text0
+ 	text _ text0.!

Item was added:
+ HtmlFormEntity subclass: #HtmlTextArea
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlTextArea>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	| inputMorph |
+ 	formatter currentFormData ifNil: [
+ 		"not in a form.  It's bogus HTML but try to survive"
+ 		^self ].
+ 
+ 	formatter ensureNewlines: 1.
+ 	inputMorph _ PluggableTextMorph on: StringHolder new text: #contents accept: #acceptContents:.
+ 	inputMorph extent: (self columns * 5) @ (self rows * inputMorph scrollDeltaHeight).
+ 	inputMorph retractable: false.
+ 	formatter addMorph: inputMorph.
+ 	formatter currentFormData addInput: (TextInput name: self name  defaultValue:  self textualContents  textMorph: inputMorph).
+ 	formatter ensureNewlines: 1.!

Item was added:
+ ----- Method: HtmlTextArea>>columns (in category 'attributes') -----
+ columns
+ 	| a |
+ 	a _ self getAttribute: 'cols' default: '20'.
+ 	^(Integer readFrom: (ReadStream on: a)) max: 5.!

Item was added:
+ ----- Method: HtmlTextArea>>defaultValue (in category 'attributes') -----
+ defaultValue
+ 	^self textualContents  "it would be nice to through the tags in there, too....  Easiest way would probably be to modiy the tokenizer"!

Item was added:
+ ----- Method: HtmlTextArea>>isBlockEntity (in category 'testing') -----
+ isBlockEntity
+ 	"not sure...."
+ 	^true!

Item was added:
+ ----- Method: HtmlTextArea>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^true   "really we shouldn't be interpretting tags in here at all, though...."!

Item was added:
+ ----- Method: HtmlTextArea>>rows (in category 'attributes') -----
+ rows
+ 	| a |
+ 	a _ self getAttribute: 'rows' default: '2'.
+ 	^(Integer readFrom: (ReadStream on: a)) max: 1.!

Item was added:
+ ----- Method: HtmlTextArea>>suppliesInput (in category 'testing') -----
+ suppliesInput
+ 	^self name ~= nil!

Item was added:
+ ----- Method: HtmlTextArea>>tagName (in category 'testing') -----
+ tagName
+ 	^'textarea'!

Item was added:
+ HtmlTextualEntity subclass: #HtmlTextEntity
+ 	instanceVariableNames: 'text'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlTextEntity>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: aFormatter
+ 	aFormatter addString: text!

Item was added:
+ ----- Method: HtmlTextEntity>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^false!

Item was added:
+ ----- Method: HtmlTextEntity>>printHtmlOn:indent: (in category 'printing') -----
+ printHtmlOn: aStream indent: indent 
+ 	indent timesRepeat: [aStream space].
+ 	aStream nextPutAll: text.
+ !

Item was added:
+ ----- Method: HtmlTextEntity>>printOn:indent: (in category 'printing') -----
+ printOn: aStream indent: indent
+ 	indent timesRepeat: [ aStream space ].
+ 	aStream nextPutAll: '['.
+ 	aStream nextPutAll: text.
+ 	aStream nextPutAll: ']'.
+ 	aStream cr.!

Item was added:
+ ----- Method: HtmlTextEntity>>tagName (in category 'testing') -----
+ tagName
+ 	"bogus"
+ 	^'x-text'  !

Item was added:
+ ----- Method: HtmlTextEntity>>text (in category 'access') -----
+ text
+ 	^text!

Item was added:
+ ----- Method: HtmlTextEntity>>text: (in category 'access') -----
+ text: text0
+ 	text _ text0!

Item was added:
+ ----- Method: HtmlTextEntity>>textualContents (in category 'contents') -----
+ textualContents
+ 	^text!

Item was added:
+ HtmlEntity subclass: #HtmlTextualEntity
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!
+ 
+ !HtmlTextualEntity commentStamp: '<historical>' prior: 0!
+ includes raw text, font-changing entities like <b> and <em>, and special entities like <a> and <img>.  All of these are relatively low level regarding formatting; they are superceded by higher level things like <li> and <p>.  When formatted, they flow around like characters.!

Item was added:
+ ----- Method: HtmlTextualEntity>>isTextualEntity (in category 'testing') -----
+ isTextualEntity
+ 	^true!

Item was added:
+ HtmlHeadEntity subclass: #HtmlTitle
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlTitle>>isHeadElement (in category 'testing') -----
+ isHeadElement
+ 	^true!

Item was added:
+ ----- Method: HtmlTitle>>mayContain: (in category 'testing') -----
+ mayContain: anEntity
+ 	^anEntity isTextualEntity!

Item was added:
+ ----- Method: HtmlTitle>>tagName (in category 'testing') -----
+ tagName
+ 	^'title'!

Item was added:
+ Object subclass: #HtmlToken
+ 	instanceVariableNames: 'source'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Tokenizer'!

Item was added:
+ ----- Method: HtmlToken class>>forSource: (in category 'instance creation') -----
+ forSource: source  
+ 	^super new initialize: source
+ !

Item was added:
+ ----- Method: HtmlToken>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: aFormatter
+ 	"add ourself to a formatter"!

Item was added:
+ ----- Method: HtmlToken>>entityFor (in category 'parser support') -----
+ entityFor
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: HtmlToken>>initialize: (in category 'private-initialization') -----
+ initialize: s
+ 	"default initialization doesn't do much.  subclasses are free to override"
+ 	source _ s
+ !

Item was added:
+ ----- Method: HtmlToken>>isComment (in category 'properties') -----
+ isComment
+ 	"whether this token is an HTML comment"
+ 	^false
+ !

Item was added:
+ ----- Method: HtmlToken>>isTag (in category 'properties') -----
+ isTag
+ 	"is this an HTML tag"
+ 	^false!

Item was added:
+ ----- Method: HtmlToken>>isText (in category 'properties') -----
+ isText
+ 	"return whether it is a string of text"
+ 	^false
+ !

Item was added:
+ ----- Method: HtmlToken>>printOn: (in category 'printing') -----
+ printOn: aStream
+ 	aStream nextPutAll: '{';
+ 		nextPutAll: self class name;
+ 		nextPut: $:;
+ 		nextPutAll: self source;
+ 		nextPut: $}.!

Item was added:
+ ----- Method: HtmlToken>>source (in category 'access') -----
+ source
+ 	"the raw source text that composes this token"
+ 	^source!

Item was added:
+ Stream subclass: #HtmlTokenizer
+ 	instanceVariableNames: 'inputStream text pos inTextArea textAreaLevel'
+ 	classVariableNames: 'CSAttributeEnders CSNameEnders CSNonSeparators'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Tokenizer'!
+ 
+ !HtmlTokenizer commentStamp: '<historical>' prior: 0!
+ This class takes a text stream and produces a sequence of HTML tokens.
+ 
+ It requires its source stream to support #peek.!

Item was added:
+ ----- Method: HtmlTokenizer class>>initialize (in category 'initialization') -----
+ initialize
+ 	"HtmlTokenizer initialize"
+ 
+ 	CSAttributeEnders _ CharacterSet empty.
+ 	CSAttributeEnders addAll: Character separators.
+ 	CSAttributeEnders add: $>.
+ 	
+ 	CSNameEnders _ CharacterSet empty.
+ 	CSNameEnders addAll: '=>'.
+ 	CSNameEnders addAll: Character separators.
+ 
+ 	CSNonSeparators _ CharacterSet separators complement.!

Item was added:
+ ----- Method: HtmlTokenizer class>>on: (in category 'instance creation') -----
+ on: aStream
+ 	^super basicNew initialize: aStream contents!

Item was added:
+ ----- Method: HtmlTokenizer>>atEnd (in category 'stream protocol') -----
+ atEnd
+ 	"are there any more tokens?  This is equivalent to whether there is any more input"
+ 	^(pos > text size)!

Item was added:
+ ----- Method: HtmlTokenizer>>initialize: (in category 'private-initialization') -----
+ initialize: s
+ 	text _ s withSqueakLineEndings.
+ 	pos _ 1.
+ 	textAreaLevel _ 0.!

Item was added:
+ ----- Method: HtmlTokenizer>>next (in category 'tokenizing') -----
+ next 
+ 	"return the next HtmlToken, or nil if there are no more"
+ 	|token|
+ 
+ 	"branch, depending on what the first character is"
+ 	self atEnd ifTrue: [ ^nil ].
+ 	self peekChar = $< 
+ 		ifTrue: [ token _ self nextTagOrComment ]
+ 		ifFalse: [ token _ self nextText ].
+ 
+ 
+ 	"return the token, modulo modifications inside of textarea's"
+ 	textAreaLevel > 0 ifTrue: [
+ 		(token isTag and: [ token name = 'textarea' ]) ifTrue: [
+ 			"textarea tag--change textAreaLevel accordingly"
+ 
+ 			token isNegated
+ 				ifTrue: [ textAreaLevel _ textAreaLevel - 1 ]
+ 				ifFalse: [ textAreaLevel _ textAreaLevel -2 ].
+ 
+ 			textAreaLevel > 0
+ 				ifTrue: [ 
+ 					"still inside a <textarea>, so convert this tag to text"
+ 					^HtmlText forSource: token source ]
+ 				ifFalse: [ "end of the textarea; return the tag"  ^token ] ].
+ 			"end of the textarea"
+ 
+ 		"inside the text area--return the token as text"
+ 		^HtmlText forSource: token source ].
+ 
+ 	(token isTag and: [ token isNegated not and: [ token name = 'textarea' ]]) ifTrue: [
+ 		"beginning of a textarea"
+ 		inTextArea _ true.
+ 		^token ].
+ 		
+ 
+ 	^token!

Item was added:
+ ----- Method: HtmlTokenizer>>nextAttributeValue (in category 'private-tokenizing') -----
+ nextAttributeValue
+ 	"return the next sequence of alphanumeric characters; used to read in the value part of a tag's attribute, ie <tagname  attribname=attribvalue>"
+ 	"because of the plethora of sloppy web pages, this is EXTREMELY tolerant"
+ 	| c start end |
+ 
+ 	"make sure there are at least two characters left"
+ 	pos >= text size ifTrue: [ ^self nextChar asString ].
+ 
+ 	"okay, peek at the first character"
+ 	start _ pos.
+ 	c _ text at: start.
+ 
+ 	"check whether it's either kind of quote mark"
+ 	(c = $" or: [ c = $' ]) ifTrue: [
+ 		"yes--so find the matching quote mark"
+ 		end _ text indexOf: c startingAt: start+1 ifAbsent: [ text size + 1 ].
+ 		pos _ end+1.
+ 		^text copyFrom: start to: end ].
+ 
+ 
+ 	"no--go until a space or a $> is seen"
+ 	end _ text indexOfAnyOf: CSAttributeEnders startingAt: start ifAbsent: [ text size + 1 ].
+ 	end _ end - 1.
+ 	pos _ end + 1.
+ 	^text copyFrom: start to: end.!

Item was added:
+ ----- Method: HtmlTokenizer>>nextChar (in category 'private') -----
+ nextChar
+ 	| c |
+ 	self atEnd ifTrue: [ ^nil ].
+ 	c _ text at: pos.
+ 	pos _ pos + 1.
+ 	^c!

Item was added:
+ ----- Method: HtmlTokenizer>>nextComment (in category 'private-tokenizing') -----
+ nextComment
+ 	"we've seen < and the next is a !!.  read until the whole comment is done"
+ 	"this isn't perfectly correct--for instance <!!--> is considered a proper comment--but it should do for now.  It also picks up <!!DOCTYPE...> tags"
+ 	| source c hyphens |
+ 	
+ 	self nextChar.   "swallow the $!!"
+ 	source _ WriteStream on: String new.
+ 	source nextPutAll: '<!!'.
+ 	
+ 	self peekChar = $- ifFalse: [ 
+ 		"this case is wierd.  go until we find a > at all and pray it's the correct end-of-'comment'"
+ 		[	self atEnd or: [ self peekChar = $> ] 
+ 		] whileFalse: [
+ 			c _ self nextChar.
+ 			source nextPut: c 
+ 		].
+ 		self atEnd ifFalse: [ source nextPut: self nextChar ].
+ 		^HtmlComment forSource: source contents ].
+ 	
+ 	hyphens _ 0.
+ 
+ 	[ 	c _ self nextChar.
+ 		c = nil or: [
+ 			source nextPut: c.
+ 			(hyphens >=2 and: [ c = $> ])]
+ 	] whileFalse: [
+ 		c = $- ifTrue: [ hyphens _ hyphens + 1 ] ifFalse: [ hyphens _ 0 ]
+ 	].
+ 		
+ 	^HtmlComment forSource: source contents.
+ !

Item was added:
+ ----- Method: HtmlTokenizer>>nextName (in category 'private-tokenizing') -----
+ nextName
+ 	"return the next sequence of alphanumeric characters"
+ 	"because of the plethora of sloppy web pages, this also accepts most non-space characters"
+ 	| start end |
+ 
+ 	start _ pos.
+ 	end _ text indexOfAnyOf: CSNameEnders startingAt: start ifAbsent: [ text size + 1].
+ 	end _ end - 1.
+ 
+ 
+ 	pos _ end+1.
+ 	^text copyFrom: start to: end!

Item was added:
+ ----- Method: HtmlTokenizer>>nextSpaces (in category 'private-tokenizing') -----
+ nextSpaces
+ 	"read in as many consecutive space characters as possible"
+ 	| start end |
+ 
+ 	"short cut for a common case"
+ 	self peekChar isSeparator not ifTrue: [ ^'' ].
+ 
+ 	"find the start and end of the sequence of spaces"
+ 	start _ pos.
+ 	end _ text indexOfAnyOf: CSNonSeparators startingAt: start ifAbsent: [ text size + 1 ].
+ 	end _ end - 1.
+ 
+ 	"update pos and return the sequence"
+ 	pos _ end + 1.
+ 	^text copyFrom: start to: end!

Item was added:
+ ----- Method: HtmlTokenizer>>nextTag (in category 'private-tokenizing') -----
+ nextTag
+ 	"we've seen a < and peek-ed something other than a !!.  Parse and return a tag"
+ 	| source negated name attribs attribName attribValue sourceStart sourceEnd c |
+ 	
+ 	sourceStart _ pos-1.
+ 	attribs _ Dictionary new.
+ 
+ 	"determine if its negated"
+ 	self peekChar = $/
+ 		ifTrue: [ negated _ true.  self nextChar. ]
+ 		ifFalse: [ negated _ false ].
+ 
+ 	"read in the name"
+ 	self skipSpaces.
+ 	name _ self nextName.
+ 	name _ name asLowercase.
+ 
+ 	"read in any attributes"
+ 	[ 	self skipSpaces.
+ 		c _ self peekChar.
+ 		c = nil or: [c isLetter not ]
+ 	] whileFalse: [
+ 		attribName _ self nextName.
+ 		attribName _ attribName asLowercase.
+ 		self skipSpaces.
+ 		self peekChar = $=
+ 			ifTrue: [
+ 				self nextChar.
+ 				self skipSpaces.
+ 				attribValue _ self nextAttributeValue withoutQuoting  ]
+ 			ifFalse: [ attribValue _ '' ].
+ 		attribs at: attribName  put: attribValue ].
+ 
+ 	self skipSpaces.
+ 	"determine if the tag is of the form <foo/>"
+ 	self peekChar = $/ ifTrue: [ self nextChar. ].
+ 	self skipSpaces.
+ 	self peekChar = $> ifTrue: [ self nextChar ].
+ 
+ 	sourceEnd _ pos-1.
+ 	source _ text copyFrom: sourceStart to: sourceEnd.
+ 
+ 	^HtmlTag source: source name: name asLowercase negated: negated attribs: attribs!

Item was added:
+ ----- Method: HtmlTokenizer>>nextTagOrComment (in category 'private-tokenizing') -----
+ nextTagOrComment
+ 	"next character is a $<.  So read either a tag or a token"
+ 	self nextChar.  "skip the $<"
+ 
+ 	^self peekChar = $!! 
+ 		ifTrue: [ self nextComment ]
+ 		ifFalse: [ self nextTag ]
+ 
+ !

Item was added:
+ ----- Method: HtmlTokenizer>>nextText (in category 'private-tokenizing') -----
+ nextText
+ 	"returns the next textual segment"
+ 	|start end|
+ 
+ 	start _ pos.
+ 	end _ (text indexOf: $< startingAt: start ifAbsent: [ text size + 1 ]) - 1.
+ 
+ 	pos _ end+1.
+ 	^HtmlText forSource: (text copyFrom: start to: end)!

Item was added:
+ ----- Method: HtmlTokenizer>>peekChar (in category 'private') -----
+ peekChar
+ 	self atEnd ifTrue: [ ^nil ].
+ 	^text at: pos!

Item was added:
+ ----- Method: HtmlTokenizer>>skipSpaces (in category 'private-tokenizing') -----
+ skipSpaces
+ 	"skip as many consecutive space characters as possible"
+ 	pos _ text indexOfAnyOf: CSNonSeparators startingAt: pos ifAbsent: [ text size + 1 ].!

Item was added:
+ HtmlFontChangeEntity subclass: #HtmlUnderlineEntity
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlUnderlineEntity>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter increaseUnderline.
+ 	super addToFormatter: formatter.	
+ 	formatter decreaseUnderline.!

Item was added:
+ HtmlList subclass: #HtmlUnorderedList
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Parser Entities'!

Item was added:
+ ----- Method: HtmlUnorderedList>>addToFormatter: (in category 'formatting') -----
+ addToFormatter: formatter
+ 	formatter startUnorderedList.
+ 	super addToFormatter: formatter.
+ 	formatter endUnorderedList.!

Item was added:
+ ----- Method: HtmlUnorderedList>>tagName (in category 'testing') -----
+ tagName
+ 	^'ul'!

Item was added:
+ ClipboardInterpreter subclass: #ISO88597ClipboardInterpreter
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-TextConversion'!

Item was added:
+ ----- Method: ISO88597ClipboardInterpreter>>fromSystemClipboard: (in category 'as yet unclassified') -----
+ fromSystemClipboard: aString
+ 
+ 	^ aString convertFromWithConverter: ISO88597TextConverter new.
+ !

Item was added:
+ ----- Method: ISO88597ClipboardInterpreter>>toSystemClipboard: (in category 'as yet unclassified') -----
+ toSystemClipboard: aString
+ 
+ 	| result converter |
+ 
+ 	aString isAsciiString ifTrue: [^ aString asOctetString]. "optimization"
+ 
+ 	result _ WriteStream on: (String new: aString size).
+ 	converter _ ISO88597TextConverter new.
+ 	aString do: [:each |
+ 		result nextPut: (converter fromSqueak: each).].
+ 	^ result contents.
+ !

Item was added:
+ KeyboardInputInterpreter subclass: #ISO88597InputInterpreter
+ 	instanceVariableNames: 'converter'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-TextConversion'!

Item was added:
+ ----- Method: ISO88597InputInterpreter>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 
+ 	converter _ ISO88597TextConverter new.
+ !

Item was added:
+ ----- Method: ISO88597InputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') -----
+ nextCharFrom: sensor firstEvt: evtBuf
+ 
+ 	| keyValue |
+ 	keyValue := evtBuf third.
+ 	^ converter toSqueak: keyValue asCharacter.
+ !

Item was added:
+ ----- Method: IconicButton>>launchPartFromClick (in category '*Etoys-Squeakland-menu') -----
+ launchPartFromClick
+ 	"The user clicked on the receiver."
+ 	arguments size = 0 ifTrue:[^self].
+ 	target launchPartVia: arguments first label: arguments second.
+ 	oldColor ifNotNil:
+ 		["if oldColor nil, it signals that mouse had not gone DOWN
+ 		inside me, e.g. because of a cmd-drag; in this case we want
+ 		to avoid triggering the action!!"
+ 		self color: oldColor.
+ 		oldColor _ nil]!

Item was added:
+ IconicButton subclass: #IconicButtonWithLabel
+ 	instanceVariableNames: 'label labelMorph'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Widgets'!

Item was added:
+ ----- Method: IconicButtonWithLabel>>initializeWithThumbnail:withLabel:andColor:andSend:to: (in category 'as yet unclassified') -----
+ initializeWithThumbnail: aThumbnail withLabel: aLabel andColor: aColor andSend: aSelector to: aReceiver 	
+ 	"Initialize the receiver to show aThumbnail on its face, giving it the label supplied and arranging for it, when the button goes down on it, to obtain a new morph by sending the supplied selector to the supplied receiver   If the label parameter is nil or an empty string, no label is used."
+ 
+ 	| nonTranslucent |
+ 	nonTranslucent := aColor asNontranslucentColor.
+ 
+ 	aLabel isEmptyOrNil ifFalse: [
+ 		labelMorph _ StringMorph contents: aLabel font:  Preferences standardEToysFont.
+ 	].
+ 
+ 	self
+ 		beTransparent;
+ 		labelGraphic: (aThumbnail originalForm) color: nonTranslucent andLabel: labelMorph;
+ 		borderWidth: 0;
+ 		target: aReceiver;
+ 		actionSelector: #launchPartVia:label:;
+ 		arguments: {aSelector. aLabel};
+ 		actWhen: #buttonDown.
+ 
+ 	self stationarySetup.!

Item was added:
+ ----- Method: IconicButtonWithLabel>>labelGraphic:color:andLabel: (in category 'as yet unclassified') -----
+ labelGraphic: aForm color: nonTranslucent andLabel: aStringMorph
+ 	| graphicalMorph labeledItem actualForm |
+ 
+ 	labeledItem _ AlignmentMorph newColumn.
+ 	labeledItem hResizing: #shrinkWrap.
+ 	labeledItem vResizing: #shrinkWrap.
+ 	labeledItem color: nonTranslucent.
+ 	labeledItem borderWidth: 0.
+ 	labeledItem
+ 		layoutInset: 4 at 0;
+ 		cellPositioning: #center.
+ 
+ 	self removeAllMorphs.
+ 	actualForm _ (Form extent: aForm extent depth: 32) fillColor: nonTranslucent.
+ 	aForm displayOn: actualForm at: 0 at 0 rule: 34.
+ 	graphicalMorph _ SketchMorph withForm: actualForm.
+ 
+ 	labeledItem addMorph: graphicalMorph.
+ 	labeledItem addMorphBack: (Morph new extent: (4 at 4)) beTransparent.
+ 	aStringMorph ifNotNil: [
+ 		labeledItem addMorphBack: aStringMorph
+ 	].
+ 
+ 	self addMorph: labeledItem.
+ 	self extent: submorphs first fullBounds extent + (borderWidth + 6).
+ 	labeledItem lock.
+ !

Item was added:
+ ----- Method: IconicButtonWithLabel>>labelString: (in category 'as yet unclassified') -----
+ labelString: aString
+ 
+ 	labelMorph ifNotNil: [
+ 		labelMorph contents: aString.
+ 		self extent: submorphs first fullBounds extent + (borderWidth + 6).
+ 	].
+ !

Item was added:
+ SkipList subclass: #IdentitySkipList
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Collections-SkipLists'!
+ 
+ !IdentitySkipList commentStamp: '<historical>' prior: 0!
+ Like a SkipList, except that elements are compared with #== instead of #= .
+ 
+ See the comment of IdentitySet for more information.
+ !

Item was added:
+ ----- Method: IdentitySkipList>>is:equalTo: (in category 'element comparison') -----
+ is: element1 equalTo: element2
+ 	^ element1 == element2!

Item was added:
+ ImageMorph subclass: #ImageMorphWithSpotlight
+ 	instanceVariableNames: 'spotImage spotShape spotBuffer spotOn'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Demo'!
+ 
+ !ImageMorphWithSpotlight commentStamp: '<historical>' prior: 0!
+ This class implements an image that appears one way or another depending upon whether it lies within a spotlight shape that moves with the cursor.  As delivered, the shape is a simple circle, the spotlighted appearance is that of a ColorForm, and the non-highlighted apperarance is a derived gray-scale form.
+ 
+ The implementation will space-efficient if supplied with a ColorForm, because the gray-scale derived form will share the same bitmap.
+ 
+ In general, any two images can be used -- one could be blurred, the other sharp -- and the masking form can be any shape.
+ 
+ At some point this class should be merged somehow with ScreeningMorph.!

Item was added:
+ ----- Method: ImageMorphWithSpotlight>>backgroundImage:spotImage:spotShape: (in category 'all') -----
+ backgroundImage: bkgndImage spotImage: anImage spotShape: formOfDepth1
+ 
+ 	"See class comment."
+ 	spotImage _ anImage.
+ 	spotShape _ formOfDepth1.
+ 	spotBuffer _ Form extent: spotShape extent depth: spotImage depth.
+ 	super image: bkgndImage.
+ 	spotOn _ false.!

Item was added:
+ ----- Method: ImageMorphWithSpotlight>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 
+ 	super drawOn: aCanvas.
+ 	spotOn ifTrue:
+ 		[aCanvas paintImage: spotBuffer at: spotBuffer offset].
+ !

Item was added:
+ ----- Method: ImageMorphWithSpotlight>>image: (in category 'accessing') -----
+ image: anImage
+ 
+ 	"The spotlight will reveal the original  form supplied
+ 	while the background form will be derived grayscale."
+ 	"See class comment."
+ 	self backgroundImage: anImage asGrayScale
+ 		spotImage: anImage
+ 		spotShape: (Form dotOfSize: 100)
+ !

Item was added:
+ ----- Method: ImageMorphWithSpotlight>>spotChanged (in category 'all') -----
+ spotChanged
+ 
+ 	self invalidRect:
+ 		((spotBuffer offset extent: spotBuffer extent) "intersect: self bounds")!

Item was added:
+ ----- Method: ImageMorphWithSpotlight>>step (in category 'stepping and presenter') -----
+ step
+ 	| cp |
+ 	((self bounds expandBy: spotBuffer extent // 2) containsPoint: (cp _ self cursorPoint))
+ 		ifTrue:
+ 		[(cp - (spotBuffer extent // 2)) = spotBuffer offset ifTrue: [^ self].  "No change"
+ 		"Cursor has moved where its spotShape is visible"
+ 		spotOn _ true.
+ 		self spotChanged.
+ 		spotBuffer offset: cp - (spotBuffer extent // 2).
+ 		self spotChanged.
+ 		(BitBlt current toForm: spotBuffer)
+ 			"clear the buffer"
+ 			fill: spotBuffer boundingBox fillColor: (Bitmap with: 0) rule: Form over;
+ 			"Clip anything outside the base form"
+ 			clipRect: (spotBuffer boundingBox
+ 				intersect: (self bounds translateBy: spotBuffer offset negated));
+ 			"Fill the spotBuffer with the spot image"
+ 			copyForm: spotImage to: self position - spotBuffer offset rule: Form over;
+ 			"Mask everything outside the spot shape to 0 (transparent)."
+ 			copyForm: spotShape to: spotShape offset negated rule: Form and
+ 				colorMap: (Bitmap with: 0 with: 16rFFFFFFFF)]
+ 		ifFalse:
+ 		[spotOn ifTrue: [self spotChanged. spotOn _ false]]!

Item was added:
+ ----- Method: ImageMorphWithSpotlight>>stepTime (in category 'testing') -----
+ stepTime
+ 
+ 	^ 20!

Item was added:
+ ----- Method: ImageSegment>>cc:new:current:fake:refStrm: (in category '*Etoys-Squeakland-compact classes') -----
+ cc: ind new: inTheSeg current: inTheImage fake: fakeCls refStrm: smartRefStream
+ 	"Sort out all the cases and decide what to do.  Every Fake class is uncompacted before having insts converted.  As the segment is installed, instances of reshaped compact classes will have the wrong class.  Trouble cases:
+ 	1) Existing class is compact in the segment and not compact here.  Make that compact, (error if that slot is used), load the segment.  If an class was just filed in, it is an existing class as far as we are concerned.
+ 	2) A compact class has a different shape.  We created a Fake class.  Load the segment, with instances in the seg having the Wrong Class!!!!  Find the bad instancees, and copy them over to being the real class.
+ 	3) An existing class is not compact in the segment, but is in the image.  Just let the new instance be uncompact.  That is OK, and never reaches this code.
+ 	A class that is a root in this segment cannot be compact.  That is not allowed."
+ 
+ 	(inTheImage == nil) & (fakeCls == nil) ifTrue: ["case 1 and empty slot" 
+ 		inTheSeg becomeCompactSimplyAt: ind.  ^ true].
+ 	
+ 	(inTheImage == inTheSeg) & (fakeCls == nil) ifTrue: ["everything matches" 
+ 		^ true].
+ 
+ 	inTheImage ifNil: ["reshaped and is an empty slot"
+ 		fakeCls becomeCompactSimplyAt: ind.  ^ true].
+ 		"comeFullyUpOnReload: will clean up"
+ 
+ 	(inTheSeg == String and:[inTheImage == ByteString]) ifTrue:[
+ 		"ar 4/10/2005: Workaround after renaming String to ByteString"
+ 		^true
+ 	].
+ 
+ 	"Is the image class really the class we are expecting?  inTheSeg came in as a DiskProxy, and was mapped if it was renamed!!"
+ 	inTheImage == inTheSeg ifFalse: [
+ 		self inform: 'The incoming class ', inTheSeg name, ' wants compact class \location ', ind printString, ', but that is occupied by ', inTheImage name, '.  \This file cannot be read into this system.  The author of the file \should make the class uncompact and create the file again.' withCRs.
+ 		^ false].
+ 
+ 	"Instances of fakeCls think they are compact, and thus will say they are instances of the class inTheImage, which is a different shape.  Just allow this to happen.  Collect them and remap them as soon as the segment is installed."
+ 	^ true!

Item was added:
+ ----- Method: ImageSegment>>classOrganizersBeRoots: (in category '*Etoys-Squeakland-read/write segment') -----
+ classOrganizersBeRoots: dummy
+ 	"The ClassOrganizers of some UniClasses may slip into OutPointers.  They point directly at the class of the UniClass (in subject).  They need to be in arrayOfRoots.  Find them and insert them into dummy's references."
+ 
+ 	dummy references keys do: [:anObject |
+ 		anObject isBehavior & (anObject isKindOf: ClassDescription) ifTrue: [
+ 			anObject theNonMetaClass isSystemDefined ifFalse: ["uniClass will be in image seg"
+ 				(dummy references includesKey: anObject organization) ifFalse: [
+ 					dummy references at: anObject organization put: 47]]]].	"will get into roots"!

Item was added:
+ ----- Method: ImageSegment>>rehashDictionaries: (in category '*Etoys-Squeakland-fileIn/Out') -----
+ rehashDictionaries: aCollection 
+ 	ProgressInitiationException
+ 		display: 'Rehash objects...'
+ 		during: [:bar | 1
+ 				to: aCollection size
+ 				do: [:i | 
+ 					(aCollection at: i) rehash.
+ 					i \\ 10 = 0
+ 						ifTrue: [bar value: i / aCollection size]]]!

Item was added:
+ ----- Method: ImageSegment>>rehashMethodDictionaries: (in category '*Etoys-Squeakland-fileIn/Out') -----
+ rehashMethodDictionaries: oldDictionaries 
+ 	| newDictionaries |
+ 	newDictionaries := oldDictionaries collect: [:d | d rehashWithoutBecome].
+ 	oldDictionaries asArray elementsForwardIdentityTo: newDictionaries asArray.
+ !

Item was added:
+ ----- Method: InfiniteForm>>alpha (in category '*Etoys-Squeakland-form protocol backstops') -----
+ alpha
+ 	"Answer the receiver's alpha,"
+ 
+ 	^ self color alpha!

Item was added:
+ ----- Method: InfiniteForm>>blue (in category '*Etoys-Squeakland-form protocol backstops') -----
+ blue
+ 	"Answer the receiver's blue,"
+ 
+ 	^ self color blue!

Item was added:
+ ----- Method: InfiniteForm>>brightness (in category '*Etoys-Squeakland-form protocol backstops') -----
+ brightness
+ 	"Answer the receiver's brightness,"
+ 
+ 	^ self color brightness!

Item was added:
+ ----- Method: InfiniteForm>>color (in category '*Etoys-Squeakland-form protocol backstops') -----
+ color
+ 	"Ansewr the receiver's color.  An InfiniteForm has single inherent color, so we report transparent."
+ 	
+ 	^ Color transparent!

Item was added:
+ ----- Method: InfiniteForm>>green (in category '*Etoys-Squeakland-form protocol backstops') -----
+ green
+ 	"Answer the receiver's green,"
+ 
+ 	^ self color green!

Item was added:
+ ----- Method: InfiniteForm>>hue (in category '*Etoys-Squeakland-form protocol backstops') -----
+ hue
+ 	"Answer the receiver's hue,"
+ 
+ 	^ self color hue!

Item was added:
+ ----- Method: InfiniteForm>>red (in category '*Etoys-Squeakland-form protocol backstops') -----
+ red
+ 	"Answer the receiver's red,"
+ 
+ 	^ self color red!

Item was added:
+ ----- Method: InfiniteForm>>saturation (in category '*Etoys-Squeakland-form protocol backstops') -----
+ saturation
+ 	"Answer the receiver's saturation,"
+ 
+ 	^ self color saturation!

Item was added:
+ ----- Method: InflateStream>>upToEndWithProgressBar (in category '*Etoys-Squeakland-accessing') -----
+ upToEndWithProgressBar
+ 	"#upToEnd with progress bar version"
+ 	| newStream buffer size |
+ 	size := sourceStream size.
+ 	ProgressInitiationException
+ 		display: 'Unzip a stream' translated
+ 		during: [:bar | 
+ 			buffer := collection species new: 1000.
+ 			newStream := WriteStream
+ 						on: (collection species new: 100).
+ 			[self atEnd]
+ 				whileFalse: [newStream
+ 						nextPutAll: (self nextInto: buffer).
+ 					bar value: (sourceStream position // size) asFloat]].
+ 	^ newStream contents!

Item was added:
+ StringMorph subclass: #InfoStringMorph
+ 	instanceVariableNames: 'stepTime block'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Demo'!
+ 
+ !InfoStringMorph commentStamp: '<historical>' prior: 0!
+ A generalization of the clock morph
+ 
+ Try
+ 	InfoStringMorph new openInWorld
+ or
+ 	(InfoStringMorph on: [Smalltalk vmParameterAt: 9])
+ 		stepTime: 50;
+ 		openInWorld!

Item was added:
+ ----- Method: InfoStringMorph class>>on: (in category 'instance creation') -----
+ on: aBlock
+ 	^ self new block: aBlock!

Item was added:
+ ----- Method: InfoStringMorph>>block (in category 'accessing') -----
+ block
+ 	^ block!

Item was added:
+ ----- Method: InfoStringMorph>>block: (in category 'accessing') -----
+ block: aBlock
+ 	block _ aBlock!

Item was added:
+ ----- Method: InfoStringMorph>>initialize (in category 'initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ 	super initialize.
+ ""
+ 	stepTime _ 1000.
+ 	block _ [Time now]!

Item was added:
+ ----- Method: InfoStringMorph>>step (in category 'stepping and presenter') -----
+ step
+ 	self contents: block value asString!

Item was added:
+ ----- Method: InfoStringMorph>>stepTime (in category 'testing') -----
+ stepTime
+ 	^ stepTime!

Item was added:
+ ----- Method: InfoStringMorph>>stepTime: (in category 'accessing') -----
+ stepTime: anInteger
+ 	stepTime _ anInteger!

Item was added:
+ Object subclass: #InputSensor
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'ButtonDecodeTable InterruptSemaphore InterruptWatcherProcess KeyDecodeTable'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Kernel-Processes'!
+ 
+ !InputSensor commentStamp: '<historical>' prior: 0!
+ An InputSensor is an interface to the user input devices.
+ There is at least one (sub)instance of InputSensor named Sensor in the system.
+ 
+ Class variables:
+ 
+ ButtonDecodeTable <ByteArray> - maps mouse buttons as reported by the VM to ones reported in the events.
+ 
+ KeyDecodeTable <Dictionary<SmallInteger->SmallInteger>> - maps some keys and their modifiers to other keys (used for instance to map Ctrl-X to Alt-X)
+ 
+ InterruptSemaphore <Semaphore> - signalled by the the VM and/or the event loop upon receiving an interrupt keystroke.
+ 
+ InterruptWatcherProcess <Process> - waits on the InterruptSemaphore and then responds as appropriate.!

Item was added:
+ ----- Method: InputSensor class>>default (in category 'public') -----
+ default
+ 	"Answer the default system InputSensor, Sensor."
+ 
+ 	^ Sensor!

Item was added:
+ ----- Method: InputSensor class>>defaultCrossPlatformKeys (in category 'class initialization') -----
+ defaultCrossPlatformKeys
+ 	"Answer a list of key letters that are used for common editing operations
+ 	on different platforms."
+ 	^{ $c . $x . $v . $a . $s . $f . $g . $z }
+ !

Item was added:
+ ----- Method: InputSensor class>>duplicateControlAndAltKeys: (in category 'public') -----
+ duplicateControlAndAltKeys: aBoolean
+ 	"InputSensor duplicateControlAndAltKeys: true"
+ 
+ 	Preferences setPreference: #duplicateControlAndAltKeys toValue: aBoolean.
+ 	self installKeyDecodeTable
+ !

Item was added:
+ ----- Method: InputSensor class>>duplicateControlAndAltKeysChanged (in category 'preference change notification') -----
+ duplicateControlAndAltKeysChanged
+ 	"The Preference for duplicateControlAndAltKeys has changed."
+ 	(Preferences
+ 		valueOfFlag: #swapControlAndAltKeys
+ 		ifAbsent: [false]) ifTrue: [
+ 			self inform: 'Resetting swapControlAndAltKeys preference'.
+ 			(Preferences preferenceAt: #swapControlAndAltKeys) rawValue: false.
+ 		].
+ 	self installKeyDecodeTable.
+ !

Item was added:
+ ----- Method: InputSensor class>>installDuplicateKeyEntryFor: (in category 'public') -----
+ installDuplicateKeyEntryFor: c
+ 	| key |
+ 	key _ c asInteger.
+ 	"first do control->alt key"
+ 	KeyDecodeTable at: { key bitAnd: 16r9F . 2 } put: { key . 8 }.
+ 	"then alt->alt key"
+ 	KeyDecodeTable at: { key . 8 } put: { key . 8 }
+ !

Item was added:
+ ----- Method: InputSensor class>>installKeyDecodeTable (in category 'class initialization') -----
+ installKeyDecodeTable
+ 	"Create a decode table that swaps some keys if 
+ 	Preferences swapControlAndAltKeys is set"
+ 	KeyDecodeTable _ Dictionary new.
+ 	Preferences duplicateControlAndAltKeys 
+ 		ifTrue: [ self defaultCrossPlatformKeys do:
+ 				[ :c | self installDuplicateKeyEntryFor: c ] ].
+ 	Preferences swapControlAndAltKeys 
+ 		ifTrue: [ self defaultCrossPlatformKeys do:
+ 				[ :c | self installSwappedKeyEntryFor: c ] ].
+ !

Item was added:
+ ----- Method: InputSensor class>>installMouseDecodeTable (in category 'class initialization') -----
+ installMouseDecodeTable
+ 	"Create a decode table that swaps the lowest-order 2 bits if 
+ 	Preferences swapMouseButtons is set"
+ 	ButtonDecodeTable _ Preferences swapMouseButtons
+ 				ifTrue: [ByteArray withAll:
+ 							((0 to: 255) collect: [:ea |
+ 								((ea bitAnd: 1) << 1
+ 									bitOr: (ea bitAnd: 2) >> 1)
+ 										bitOr: (ea bitAnd: 16rFC) ])]
+ 				ifFalse: [ByteArray
+ 						withAll: (0 to: 255)]!

Item was added:
+ ----- Method: InputSensor class>>installSwappedKeyEntryFor: (in category 'public') -----
+ installSwappedKeyEntryFor: c
+ 	| key |
+ 	key _ c asInteger.
+ 	"first do control->alt key"
+ 	KeyDecodeTable at: { key bitAnd: 16r9F . 2 } put: { key . 8 }.
+ 	"then alt->control key"
+ 	KeyDecodeTable at: { key . 8 } put: { key bitAnd: 16r9F . 2 }!

Item was added:
+ ----- Method: InputSensor class>>keyDecodeTable (in category 'public') -----
+ keyDecodeTable
+ 	^KeyDecodeTable ifNil: [ self installKeyDecodeTable ]!

Item was added:
+ ----- Method: InputSensor class>>shutDown (in category 'system startup') -----
+ shutDown
+ 	self default shutDown.!

Item was added:
+ ----- Method: InputSensor class>>startUp (in category 'system startup') -----
+ startUp
+ 	
+ 	self installMouseDecodeTable.
+ 	self installKeyDecodeTable.
+ 	self default startUp!

Item was added:
+ ----- Method: InputSensor class>>swapControlAndAltKeys: (in category 'public') -----
+ swapControlAndAltKeys: aBoolean
+ 	"InputSensor swapControlAndAltKeys: true"
+ 
+ 	Preferences setPreference: #swapControlAndAltKeys toValue: aBoolean.
+ 	self installKeyDecodeTable!

Item was added:
+ ----- Method: InputSensor class>>swapControlAndAltKeysChanged (in category 'preference change notification') -----
+ swapControlAndAltKeysChanged
+ 	"The Preference for swapControlAndAltKeys has changed."
+ 	(Preferences
+ 		valueOfFlag: #duplicateControlAndAltKeys
+ 		ifAbsent: [false]) ifTrue: [
+ 			self inform: 'Resetting duplicateControlAndAltKeys preference'.
+ 			(Preferences preferenceAt: #duplicateControlAndAltKeys) rawValue: false.
+ 		].
+ 	self installKeyDecodeTable.
+ !

Item was added:
+ ----- Method: InputSensor class>>swapMouseButtons: (in category 'public') -----
+ swapMouseButtons: aBoolean
+ 	"InputSensor swapMouseButtons: true"
+ 
+ 	Preferences setPreference: #swapMouseButtons toValue: aBoolean.
+ 	self installMouseDecodeTable.!

Item was added:
+ ----- Method: InputSensor>>anyButtonPressed (in category 'mouse') -----
+ anyButtonPressed
+ 	"Answer whether at least one mouse button is currently being pressed."
+ 
+ 	^ self primMouseButtons anyMask: 7
+ !

Item was added:
+ ----- Method: InputSensor>>anyModifierKeyPressed (in category 'modifier keys') -----
+ anyModifierKeyPressed
+ 	"ignore, however, the shift keys 'cause that's not REALLY a command key"
+ 
+ 	^ self primMouseButtons anyMask: 16r70	"cmd | opt | ctrl"!

Item was added:
+ ----- Method: InputSensor>>blueButtonPressed (in category 'mouse') -----
+ blueButtonPressed
+ 	"Answer whether only the blue mouse button is being pressed. 
+ 	This is the third mouse button or cmd+click on the Mac."
+ 
+ 	^ (self primMouseButtons bitAnd: 7) = 1
+ !

Item was added:
+ ----- Method: InputSensor>>buttons (in category 'buttons') -----
+ buttons
+ 	"Answer the result of primMouseButtons, but swap the mouse  
+ 	buttons if Preferences swapMouseButtons is set."
+ 	^ ButtonDecodeTable at: self primMouseButtons + 1!

Item was added:
+ ----- Method: InputSensor>>characterForKeycode: (in category 'private') -----
+ characterForKeycode: keycode
+ 	"Map the given keycode to a Smalltalk character object. Encoding:
+ 		A keycode is 12 bits:   <4 modifer bits><8 bit ISO character>
+ 		Modifier bits are:       <command><option><control><shift>"
+ 
+ 	"NOTE: the command and option keys are specific to the Macintosh and may not have equivalents on other platforms."
+ 
+ 	keycode = nil ifTrue: [ ^nil ].
+ 	keycode class = Character ifTrue: [ ^keycode ].  "to smooth the transition!!"
+ 	^ Character value: (keycode bitAnd: 16rFF)!

Item was added:
+ ----- Method: InputSensor>>commandKeyPressed (in category 'modifier keys') -----
+ commandKeyPressed
+ 	"Answer whether the command key on the keyboard is being held down."
+ 
+ 	^ self primMouseButtons anyMask: 64!

Item was added:
+ ----- Method: InputSensor>>controlKeyPressed (in category 'modifier keys') -----
+ controlKeyPressed
+ 	"Answer whether the control key on the keyboard is being held down."
+ 
+ 	^ self primMouseButtons anyMask: 16!

Item was added:
+ ----- Method: InputSensor>>currentCursor (in category 'cursor') -----
+ currentCursor
+ 	"The current cursor is maintained in class Cursor."
+ 
+ 	^ Cursor currentCursor!

Item was added:
+ ----- Method: InputSensor>>currentCursor: (in category 'cursor') -----
+ currentCursor: newCursor 
+ 	"The current cursor is maintained in class Cursor."
+ 
+ 	Cursor currentCursor: newCursor.!

Item was added:
+ ----- Method: InputSensor>>cursorPoint (in category 'cursor') -----
+ cursorPoint
+ 	"Answer a Point indicating the cursor location."
+ 
+ 	^self mousePoint!

Item was added:
+ ----- Method: InputSensor>>cursorPoint: (in category 'cursor') -----
+ cursorPoint: aPoint 
+ 	"Set aPoint to be the current cursor location."
+ 
+ 	^self primCursorLocPut: aPoint!

Item was added:
+ ----- Method: InputSensor>>eventQueue (in category 'accessing') -----
+ eventQueue
+ 	^nil!

Item was added:
+ ----- Method: InputSensor>>eventQueue: (in category 'accessing') -----
+ eventQueue: aSharedQueue
+ !

Item was added:
+ ----- Method: InputSensor>>eventTicklerProcess (in category 'user interrupts') -----
+ eventTicklerProcess
+ 	"Answer my event tickler process, if any"
+ 	^nil!

Item was added:
+ ----- Method: InputSensor>>flushAllButDandDEvents (in category 'accessing') -----
+ flushAllButDandDEvents!

Item was added:
+ ----- Method: InputSensor>>flushEvents (in category 'initialize') -----
+ flushEvents
+ 	"Do nothing"!

Item was added:
+ ----- Method: InputSensor>>flushKeyboard (in category 'keyboard') -----
+ flushKeyboard
+ 	"Remove all characters from the keyboard buffer."
+ 
+ 	[self keyboardPressed]
+ 		whileTrue: [self keyboard]!

Item was added:
+ ----- Method: InputSensor>>hasTablet (in category 'tablet') -----
+ hasTablet
+ 	"Answer true if there is a pen tablet available on this computer."
+ 
+ 	^ (self primTabletGetParameters: 1) notNil
+ !

Item was added:
+ ----- Method: InputSensor>>inputProcess (in category 'user interrupts') -----
+ inputProcess
+ 	"For non-event image compatibility"
+ 	^ nil!

Item was added:
+ ----- Method: InputSensor>>installInterruptWatcher (in category 'user interrupts') -----
+ installInterruptWatcher
+ 	"Initialize the interrupt watcher process. Terminate the old process if any."
+ 	"Sensor installInterruptWatcher"
+ 
+ 	InterruptWatcherProcess ifNotNil: [InterruptWatcherProcess terminate].
+ 	InterruptSemaphore _ Semaphore new.
+ 	InterruptWatcherProcess _ [self userInterruptWatcher] forkAt: Processor lowIOPriority.
+ 	self primInterruptSemaphore: InterruptSemaphore.!

Item was added:
+ ----- Method: InputSensor>>interruptWatcherProcess (in category 'user interrupts') -----
+ interruptWatcherProcess
+ 	"Answer my interrupt watcher process, if any"
+ 	^InterruptWatcherProcess!

Item was added:
+ ----- Method: InputSensor>>joystickButtons: (in category 'joystick') -----
+ joystickButtons: index
+ 
+ 	^ ((self primReadJoystick: index) bitShift: -22) bitAnd: 16r71F
+ 	!

Item was added:
+ ----- Method: InputSensor>>joystickOn: (in category 'joystick') -----
+ joystickOn: index
+ 
+ 	^ (((self primReadJoystick: index) bitShift: -27) bitAnd: 1) ~= 0
+ 	!

Item was added:
+ ----- Method: InputSensor>>joystickXY: (in category 'joystick') -----
+ joystickXY: index
+ 
+ 	| inputWord x y |
+ 	inputWord _ self primReadJoystick: index.
+ 	x _ (inputWord bitAnd: 16r7FF) - 16r400.
+ 	y _ ((inputWord bitShift: -11) bitAnd: 16r7FF) - 16r400.
+ 	^ x at y
+ 	!

Item was added:
+ ----- Method: InputSensor>>kbdTest (in category 'keyboard') -----
+ kbdTest    "Sensor kbdTest"
+ 	"This test routine will print the unmodified character, its keycode,
+ 	and the OR of all its modifier bits, until the character x is typed"
+ 	| char |
+ 	char _ nil.
+ 	[char = $x] whileFalse: 
+ 		[[self keyboardPressed] whileFalse: [].
+ 		char _ self characterForKeycode: self keyboard.
+ 		(String streamContents: 
+ 			[:s | s nextPut: char; space; print: char asciiValue;
+ 					space; print: self primMouseButtons; nextPutAll: '     '])
+ 			displayAt: 10 at 10]!

Item was added:
+ ----- Method: InputSensor>>keyboard (in category 'keyboard') -----
+ keyboard
+ 	"Answer the next character from the keyboard."
+ 
+ 	| firstCharacter secondCharactor stream multiCharacter converter |
+ 	firstCharacter _ self characterForKeycode: self primKbdNext.
+ 	secondCharactor _ self characterForKeycode: self primKbdPeek.
+ 	secondCharactor isNil
+ 		ifTrue: [^ firstCharacter].
+ 	converter _ TextConverter defaultSystemConverter.
+ 	converter isNil
+ 		ifTrue: [^ firstCharacter].
+ 	stream _ ReadStream
+ 				on: (String with: firstCharacter with: secondCharactor).
+ 	multiCharacter _ converter nextFromStream: stream.
+ 	multiCharacter isOctetCharacter
+ 		ifTrue: [^ multiCharacter].
+ 	self primKbdNext.
+ 	^ multiCharacter
+ !

Item was added:
+ ----- Method: InputSensor>>keyboardPeek (in category 'keyboard') -----
+ keyboardPeek
+ 	"Answer the next character in the keyboard buffer without removing it, or nil if it is empty."
+ 
+ 	^ self characterForKeycode: self primKbdPeek!

Item was added:
+ ----- Method: InputSensor>>keyboardPressed (in category 'keyboard') -----
+ keyboardPressed
+ 	"Answer true if keystrokes are available."
+ 
+ 	^self primKbdPeek notNil!

Item was added:
+ ----- Method: InputSensor>>leftShiftDown (in category 'modifier keys') -----
+ leftShiftDown
+ 	"Answer whether the shift key on the keyboard is being held down. The name of this message is a throwback to the Alto, which had independent left and right shift keys."
+ 
+ 	^ self primMouseButtons anyMask: 8!

Item was added:
+ ----- Method: InputSensor>>macOptionKeyPressed (in category 'modifier keys') -----
+ macOptionKeyPressed
+ 	"Answer whether the option key on the Macintosh keyboard is being held down. Macintosh specific."
+ 
+ 	Preferences macOptionKeyAllowed ifFalse: [self notifyWithLabel: 'Portability note:
+ InputSensor>>macOptionKeyPressed is not portable.
+ Please use InputSensor>>yellowButtonPressed instead!!'].
+ 	^ self primMouseButtons anyMask: 32!

Item was added:
+ ----- Method: InputSensor>>mouseButtons (in category 'mouse') -----
+ mouseButtons
+ 	"Answer a number from 0 to 7 that encodes the state of the three mouse buttons in its lowest 3 bits."
+ 
+ 	^ self primMouseButtons bitAnd: 7
+ !

Item was added:
+ ----- Method: InputSensor>>mousePoint (in category 'mouse') -----
+ mousePoint
+ 	"Answer a Point indicating the coordinates of the current mouse location."
+ 
+ 	^self primMousePt!

Item was added:
+ ----- Method: InputSensor>>noButtonPressed (in category 'mouse') -----
+ noButtonPressed
+ 	"Answer whether any mouse button is not being pressed."
+ 
+ 	^self anyButtonPressed not
+ !

Item was added:
+ ----- Method: InputSensor>>peekButtons (in category 'mouse') -----
+ peekButtons
+ 	^self primMouseButtons!

Item was added:
+ ----- Method: InputSensor>>peekMousePt (in category 'mouse') -----
+ peekMousePt
+ 	^self primMousePt!

Item was added:
+ ----- Method: InputSensor>>peekPosition (in category 'cursor') -----
+ peekPosition
+ 	^self cursorPoint!

Item was added:
+ ----- Method: InputSensor>>primCursorLocPut: (in category 'private') -----
+ primCursorLocPut: aPoint
+ 	"If the primitive fails, try again with a rounded point."
+ 
+ 	<primitive: 91>
+ 	^ self primCursorLocPutAgain: aPoint rounded!

Item was added:
+ ----- Method: InputSensor>>primCursorLocPutAgain: (in category 'private') -----
+ primCursorLocPutAgain: aPoint
+ 	"Do nothing if primitive is not implemented."
+ 
+ 	<primitive: 91>
+ 	^ self!

Item was added:
+ ----- Method: InputSensor>>primInterruptSemaphore: (in category 'private') -----
+ primInterruptSemaphore: aSemaphore 
+ 	"Primitive. Install the argument as the semaphore to be signalled whenever the user presses the interrupt key. The semaphore will be signaled once each time the interrupt key is pressed."
+ 
+ 	<primitive: 134>
+ 	^self primitiveFailed
+ "Note: This primitive is obsolete with the new event driven architecture in which EventSensor can handle the interrupts itself. However, for supporting older images running on newer VMs the primitive must still be implemented."!

Item was added:
+ ----- Method: InputSensor>>primKbdNext (in category 'private') -----
+ primKbdNext
+ 	<primitive: 108>
+ 	^ nil!

Item was added:
+ ----- Method: InputSensor>>primKbdPeek (in category 'private') -----
+ primKbdPeek
+ 	<primitive: 109>
+ 	^ nil!

Item was added:
+ ----- Method: InputSensor>>primMouseButtons (in category 'private') -----
+ primMouseButtons
+ 	<primitive: 107>
+ 	^ 0!

Item was added:
+ ----- Method: InputSensor>>primMousePt (in category 'private') -----
+ primMousePt
+ 	"Primitive. Poll the mouse to find out its position. Return a Point. Fail if
+ 	event-driven tracking is used instead of polling. Optional. See Object
+ 	documentation whatIsAPrimitive."
+ 
+ 	<primitive: 90>
+ 	^ 0 at 0!

Item was added:
+ ----- Method: InputSensor>>primReadJoystick: (in category 'private') -----
+ primReadJoystick: index
+ 	"Return the joystick input word for the joystick with the given index in the range [1..16]. Returns zero if the index does not correspond to a currently installed joystick."
+ 
+ 	<primitive: 'primitiveReadJoystick' module: 'JoystickTabletPlugin'>
+ 	^ 0
+ 
+ 	!

Item was added:
+ ----- Method: InputSensor>>primSetInterruptKey: (in category 'private') -----
+ primSetInterruptKey: anInteger
+ 	"Primitive. Register the given keycode as the user interrupt key. The low byte of the keycode is the ISO character and its next four bits are the Smalltalk modifer bits <cmd><opt><ctrl><shift>."
+ 
+ 	<primitive: 133>
+ 	^self primitiveFailed
+ "Note: This primitive is obsolete with the new event driven architecture in which EventSensor can handle the interrupts itself. However, for supporting older images running on newer VMs the primitive must still be implemented."!

Item was added:
+ ----- Method: InputSensor>>primTabletGetParameters: (in category 'private') -----
+ primTabletGetParameters: cursorIndex
+ 	"Answer the pen tablet parameters. For parameters that differ from cursor to cursor, answer those associated with the cursor having the given index. Answer nil if there is no pen tablet. The parameters are:
+ 	1. tablet width, in tablet units
+ 	2. tablet height, in tablet units
+ 	3. number of tablet units per inch
+ 	4. number of cursors (pens, pucks, etc; some tablets have more than one)
+ 	5. this cursor index
+ 	6. and 7. x scale and x offset for scaling tablet coordintes (e.g., to fit the screen)
+ 	8. and 9. y scale and y offset for scaling tablet coordintes  (e.g., to fit the screen)
+ 	10. number of pressure levels
+ 	11. presure threshold needed close pen tip switch 
+ 	12. number of pen tilt angles"
+ 
+ 	<primitive: 'primitiveGetTabletParameters' module: 'JoystickTabletPlugin'>
+ 	^ nil
+ !

Item was added:
+ ----- Method: InputSensor>>primTabletRead: (in category 'private') -----
+ primTabletRead: cursorIndex
+ 	"Answer the pen tablet data for the cursor having the given index. Answer nil if there is no pen tablet. The data is:
+ 	1. index of the cursor to which this data applies
+ 	2. timestamp of the last state chance for this cursor
+ 	3., 4., and 5. x, y, and z coordinates of the cursor (z is typically 0)
+ 	6. and 7. xTilt and yTilt of the cursor; (signed)
+ 	8. type of cursor (0 = unknown, 1 = pen, 2 = puck, 3 = eraser)
+ 	9. cursor buttons
+ 	10. cursor pressure, downward
+ 	11. cursor pressure, tangential
+ 	12. flags"
+ 
+ 	<primitive: 'primitiveReadTablet' module: 'JoystickTabletPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: InputSensor>>rawMacOptionKeyPressed (in category 'modifier keys') -----
+ rawMacOptionKeyPressed
+ 	"Answer whether the option key on the Macintosh keyboard is being held down. Macintosh specific.  Clients are discouraged from calling this directly, since it circumvents bert's attempt to eradicate option-key checks"
+ 
+ 	^ self primMouseButtons anyMask: 32!

Item was added:
+ ----- Method: InputSensor>>redButtonPressed (in category 'mouse') -----
+ redButtonPressed
+ 	"Answer true if only the red mouse button is being pressed.
+ 	This is the first mouse button, usually the left one."
+ 
+ 	^ (self primMouseButtons bitAnd: 7) = 4
+ !

Item was added:
+ ----- Method: InputSensor>>setInterruptKey: (in category 'user interrupts') -----
+ setInterruptKey: anInteger
+ 	"Register the given keycode as the user interrupt key."
+ 
+ 	self primSetInterruptKey: anInteger.
+ !

Item was added:
+ ----- Method: InputSensor>>shiftPressed (in category 'modifier keys') -----
+ shiftPressed
+ 	"Answer whether the shift key on the keyboard is being held down."
+ 
+ 	^ self primMouseButtons anyMask: 8
+ !

Item was added:
+ ----- Method: InputSensor>>shutDown (in category 'initialize') -----
+ shutDown
+ 	InterruptWatcherProcess ifNotNil: [
+ 		InterruptWatcherProcess terminate.
+ 		InterruptWatcherProcess _ nil ].!

Item was added:
+ ----- Method: InputSensor>>startUp (in category 'initialize') -----
+ startUp
+ 	self installInterruptWatcher.!

Item was added:
+ ----- Method: InputSensor>>tabletExtent (in category 'tablet') -----
+ tabletExtent
+ 	"Answer the full tablet extent in tablet coordinates."
+ 
+ 	| params |
+ 	params _ self primTabletGetParameters: 1.
+ 	params ifNil: [^ self error: 'no tablet available'].
+ 	^ (params at: 1)@(params at: 2)
+ !

Item was added:
+ ----- Method: InputSensor>>tabletPoint (in category 'tablet') -----
+ tabletPoint
+ 	"Answer the current position of the first tablet pointing device (pen, puck, or eraser) in tablet coordinates."
+ 
+ 	| data |
+ 	data _ self primTabletRead: 1.  "state of first/primary pen"
+ 	^ (data at: 3) @ (data at: 4)
+ !

Item was added:
+ ----- Method: InputSensor>>tabletPressure (in category 'tablet') -----
+ tabletPressure
+ 	"Answer the current pressure of the first tablet pointing device (pen, puck, or eraser), a number between 0.0 (no pressure) and 1.0 (max pressure)"
+ 
+ 	| params data |
+ 	params _ self primTabletGetParameters: 1.
+ 	params ifNil: [^ self].
+ 	data _ self primTabletRead: 1.  "state of first/primary pen"
+ 	^ (data at: 10) asFloat / ((params at: 10) - 1)
+ !

Item was added:
+ ----- Method: InputSensor>>tabletTimestamp (in category 'tablet') -----
+ tabletTimestamp
+ 	"Answer the time (in tablet clock ticks) at which the tablet's primary pen last changed state. This can be used in polling loops; if this timestamp hasn't changed, then the pen state hasn't changed either."
+ 
+ 	| data |
+ 	data _ self primTabletRead: 1.  "state of first/primary pen"
+ 	^ data at: 2
+ !

Item was added:
+ ----- Method: InputSensor>>testJoystick: (in category 'joystick') -----
+ testJoystick: index
+ 	"Sensor testJoystick: 3"
+ 
+ 	| f pt buttons status |
+ 	f _ Form extent: 110 at 50.
+ 	[Sensor anyButtonPressed] whileFalse: [
+ 		pt _ Sensor joystickXY: index.
+ 		buttons _ Sensor joystickButtons: index.
+ 		status _
+ 'xy: ', pt printString, '
+ buttons: ', buttons hex.
+ 		f fillWhite.
+ 		status displayOn: f at: 10 at 10.
+ 		f displayOn: Display at: 10 at 10.
+ 	].
+ !

Item was added:
+ ----- Method: InputSensor>>userInterruptWatcher (in category 'user interrupts') -----
+ userInterruptWatcher
+ 	"Wait for user interrupts and open a notifier on the active process when one occurs."
+ 
+ 	[true] whileTrue: [
+ 		InterruptSemaphore wait.
+ 		Display deferUpdates: false.
+ 		SoundService default shutDown.
+ 		Smalltalk handleUserInterrupt]
+ !

Item was added:
+ ----- Method: InputSensor>>waitButton (in category 'mouse') -----
+ waitButton
+ 	"Wait for the user to press any mouse button and then answer with the 
+ 	current location of the cursor."
+ 
+ 	| delay |
+ 	delay _ Delay forMilliseconds: 50.
+ 	[self anyButtonPressed] whileFalse: [ delay wait ].
+ 	^self cursorPoint
+ !

Item was added:
+ ----- Method: InputSensor>>waitButtonOrKeyboard (in category 'mouse') -----
+ waitButtonOrKeyboard
+ 	"Wait for the user to press either any mouse button or any key. 
+ 	Answer the current cursor location or nil if a keypress occured."
+ 
+ 	| delay |
+ 	delay := Delay forMilliseconds: 50.
+ 	[self anyButtonPressed]
+ 		whileFalse: [delay wait.
+ 			self keyboardPressed
+ 				ifTrue: [^ nil]].
+ 	^ self cursorPoint
+ !

Item was added:
+ ----- Method: InputSensor>>waitClickButton (in category 'mouse') -----
+ waitClickButton
+ 	"Wait for the user to click (press and then release) any mouse button and 
+ 	then answer with the current location of the cursor."
+ 
+ 	self waitButton.
+ 	^self waitNoButton!

Item was added:
+ ----- Method: InputSensor>>waitNoButton (in category 'mouse') -----
+ waitNoButton
+ 	"Wait for the user to release any mouse button and then answer the current location of the cursor."
+ 
+ 	| delay |
+ 	delay _ Delay forMilliseconds: 50.
+ 	[self anyButtonPressed] whileTrue: [ delay wait].
+ 	^self cursorPoint
+ !

Item was added:
+ ----- Method: InputSensor>>yellowButtonPressed (in category 'mouse') -----
+ yellowButtonPressed
+ 	"Answer whether only the yellow mouse button is being pressed. 
+ 	This is the second mouse button or option+click on the Mac."
+ 
+ 	^ (self primMouseButtons bitAnd: 7) = 2
+ !

Item was added:
+ Object subclass: #InputSpec
+ 	instanceVariableNames: 'type attributeName uniqueName rawGetter'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tweak-Kedama-ParseTreeTransformer'!

Item was added:
+ ----- Method: InputSpec>>attributeName (in category 'all') -----
+ attributeName
+ 
+ 	^ attributeName.
+ !

Item was added:
+ ----- Method: InputSpec>>attributeName: (in category 'all') -----
+ attributeName: aSymbol
+ 
+ 	attributeName _ aSymbol.
+ 	rawGetter _ ('raw', attributeName) asSymbol.
+ 	"rawGetter _ attributeName asSymbol."
+ !

Item was added:
+ ----- Method: InputSpec>>printOn: (in category 'all') -----
+ printOn: aStream
+ 
+ 	aStream nextPutAll: 'InputSpec(';
+ 		nextPutAll: attributeName;
+ 		nextPut: $).
+ !

Item was added:
+ ----- Method: InputSpec>>rawGetter (in category 'all') -----
+ rawGetter
+ 
+ 	^ rawGetter.
+ !

Item was added:
+ ----- Method: InputSpec>>type (in category 'all') -----
+ type
+ 
+ 	^ type.
+ !

Item was added:
+ ----- Method: InputSpec>>type: (in category 'all') -----
+ type: aSymbol
+ 
+ 	"#parentInh, #parentSynth, #parentInhFirstChild, #elderSiblingSynth, #lastChildSynth, #mySynth #myInh, #allChildrenSynth, #intrinsic"
+ 	type _ aSymbol.
+ !

Item was added:
+ ----- Method: InputSpec>>uniqueName (in category 'all') -----
+ uniqueName
+ 
+ 	^ uniqueName.
+ !

Item was added:
+ ----- Method: InputSpec>>uniqueName: (in category 'all') -----
+ uniqueName: aString
+ 
+ 	uniqueName _ aString.
+ !

Item was added:
+ ----- Method: Inspector class>>horizontalDividerProportion (in category '*Etoys-Squeakland-instance creation') -----
+ horizontalDividerProportion
+ 	^ 0.4!

Item was added:
+ ----- Method: InstructionStream>>interpretExtension:in:for: (in category '*Etoys-Squeakland-private') -----
+ interpretExtension: offset in: method for: client
+ 	| type offset2 byte2 byte3 |
+ 	offset <=6 ifTrue: 
+ 		["Extended op codes 128-134"
+ 		byte2 _ method at: pc.
+ 		pc _ pc + 1.
+ 		offset <= 2 ifTrue:
+ 			["128-130:  extended pushes and pops"
+ 			type _ byte2 // 64.
+ 			offset2 _ byte2 \\ 64.
+ 			offset = 0 ifTrue: 
+ 				[type = 0 ifTrue: [^ client pushReceiverVariable: offset2].
+ 				type = 1 ifTrue: [^ client pushTemporaryVariable: offset2].
+ 				type = 2  ifTrue: [^ client pushConstant: (method literalAt: offset2 + 1)].
+ 				type = 3 ifTrue: [^ client pushLiteralVariable: (method literalAt: offset2 + 1)]].
+ 			offset = 1 ifTrue: 
+ 				[type = 0 ifTrue: [^ client storeIntoReceiverVariable: offset2].
+ 				type = 1 ifTrue: [^ client storeIntoTemporaryVariable: offset2].
+ 				type = 2 ifTrue: [self error: 'illegalStore'].
+ 				type = 3 ifTrue: [^ client storeIntoLiteralVariable: (method literalAt: offset2 + 1)]].
+ 			offset = 2 ifTrue: 
+ 				[type = 0 ifTrue: [^ client popIntoReceiverVariable: offset2].
+ 				type = 1 ifTrue: [^ client popIntoTemporaryVariable: offset2].
+ 				type = 2 ifTrue: [self error: 'illegalStore'].
+ 				type = 3  ifTrue: [^ client popIntoLiteralVariable: (method literalAt: offset2 + 1)]]].
+ 		"131-134: extended sends"
+ 		offset = 3 ifTrue:  "Single extended send"
+ 			[^ client send: (method literalAt: byte2 \\ 32 + 1)
+ 					super: false numArgs: byte2 // 32].
+ 		offset = 4 ifTrue:    "Double extended do-anything"
+ 			[byte3 _ method at: pc.  pc _ pc + 1.
+ 			type _ byte2 // 32.
+ 			type = 0 ifTrue: [^ client send: (method literalAt: byte3 + 1)
+ 									super: false numArgs: byte2 \\ 32].
+ 			type = 1 ifTrue: [^ client send: (method literalAt: byte3 + 1)
+ 									super: true numArgs: byte2 \\ 32].
+ 			type = 2 ifTrue: [^ client pushReceiverVariable: byte3].
+ 			type = 3 ifTrue: [^ client pushConstant: (method literalAt: byte3 + 1)].
+ 			type = 4 ifTrue: [^ client pushLiteralVariable: (method literalAt: byte3 + 1)].
+ 			type = 5 ifTrue: [^ client storeIntoReceiverVariable: byte3].
+ 			type = 6 ifTrue: [^ client popIntoReceiverVariable: byte3].
+ 			type = 7 ifTrue: [^ client storeIntoLiteralVariable: (method literalAt: byte3 + 1)]].
+ 		offset = 5 ifTrue:  "Single extended send to super"
+ 			[^ client send: (method literalAt: byte2 \\ 32 + 1)
+ 					super: true numArgs: byte2 // 32].
+ 		offset = 6 ifTrue:   "Second extended send"
+ 			[^ client send: (method literalAt: byte2 \\ 64 + 1)
+ 					super: false numArgs: byte2 // 64]].
+ 	offset = 7 ifTrue: [^ client doPop].
+ 	offset = 8 ifTrue: [^ client doDup].
+ 	offset = 9 ifTrue: [^ client pushActiveContext].
+ 	self error: 'unusedBytecode'!

Item was added:
+ ----- Method: Integer>>safeFactorial (in category '*Etoys-Squeakland-mathematical functions') -----
+ safeFactorial
+ 	"Answer the factorial of the receiver, guarding against bad argument"
+ 
+ 	self = 0 ifTrue: [^ 1].
+ 	self > 0 ifTrue: [^ self * (self - 1) factorial].
+ 	ScriptingSystem reportToUser:  'Factorial not defined for negative numbers' translated!

Item was added:
+ FlapTab subclass: #InteriorFlapTab
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !InteriorFlapTab commentStamp: 'sw 10/25/2006 03:59' prior: 0!
+ A Flap Tab that clings to an edge of a PasteUpMorph that is not a World.!

Item was added:
+ ----- Method: InteriorFlapTab>>hideFlap (in category 'show & hide') -----
+ hideFlap
+ 	"Close the flap."
+ 
+ 	self privateDeleteReferent.
+ 	flapShowing := false.
+ 	self adjustPositionAfterHidingFlap!

Item was added:
+ ----- Method: InteriorFlapTab>>maybeHideFlapOnMouseLeaveDragging (in category 'show & hide') -----
+ maybeHideFlapOnMouseLeaveDragging
+ 	"After the mouse leaves, having dragged something out, perhaps close the flap."
+ 
+ 	| aPasteUpMorph |
+ 	self hasHalo ifTrue: [^ self].
+ 	referent isInWorld ifFalse: [^ self].
+ 	(dragged or: [referent bounds containsPoint: self cursorPoint])
+ 		ifTrue:	[^ self].
+ 	aPasteUpMorph := self pasteUpMorph.
+ 	self privateDeleteReferent.  "could make me worldless if I'm inboard"
+ 	aPasteUpMorph ifNotNil: [aPasteUpMorph removeAccommodationForFlap: self].
+ 	flapShowing := false.
+ 	self isInWorld ifFalse: [aPasteUpMorph  ifNotNil: [aPasteUpMorph addMorphFront: self]].
+ 	self adjustPositionAfterHidingFlap!

Item was added:
+ ----- Method: InteriorFlapTab>>mouseMove: (in category 'event handling') -----
+ mouseMove: evt
+ 	"Handle a mouseMove event in the flap tab."
+ 
+ 	| aPosition newReferentThickness adjustedPosition thick relativePosition |
+ 	dragged ifFalse: [(thick _ self referentThickness) > 0
+ 			ifTrue: [lastReferentThickness _ thick]].
+ 	((self containsPoint: (aPosition _ evt cursorPoint)) and: [dragged not])
+ 		ifFalse:
+ 			[flapShowing ifFalse: [self showFlap].
+ 			relativePosition := aPosition - evt hand targetOffset.
+ 			adjustedPosition := aPosition - (owner position + evt hand targetOffset).
+ 			(edgeToAdhereTo == #bottom)
+ 				ifTrue:
+ 					[newReferentThickness _ inboard
+ 						ifTrue:
+ 							[owner height - adjustedPosition y]
+ 						ifFalse:
+ 							[owner height - adjustedPosition y - self height]].
+ 
+ 			(edgeToAdhereTo == #left)
+ 					ifTrue:
+ 						[newReferentThickness _
+ 							inboard
+ 								ifTrue:
+ 									[adjustedPosition x + self width]
+ 								ifFalse:
+ 									[adjustedPosition x]].
+ 
+ 			(edgeToAdhereTo == #right)
+ 					ifTrue:
+ 						[newReferentThickness _
+ 							inboard
+ 								ifTrue:
+ 									[owner width - adjustedPosition x]
+ 								ifFalse:
+ 									[owner width - adjustedPosition x - self width]].
+ 
+ 			(edgeToAdhereTo == #top)
+ 					ifTrue:
+ 						[newReferentThickness _
+ 							inboard
+ 								ifTrue:
+ 									[adjustedPosition y + self height]
+ 								ifFalse:
+ 									[adjustedPosition y]].
+ 		
+ 			self isCurrentlySolid ifFalse:
+ 				[(#(left right) includes: edgeToAdhereTo)
+ 					ifFalse:
+ 						[self left: relativePosition x]
+ 					ifTrue:
+ 						[self top: relativePosition y]].
+ 
+ 			self applyThickness: newReferentThickness.
+ 			dragged _ true.
+ 			self fitOnScreen.
+ 			self computeEdgeFraction]!

Item was added:
+ ----- Method: InteriorFlapTab>>positionObject:atEdgeOf: (in category 'positioning') -----
+ positionObject: anObject atEdgeOf: container
+         "anObject could be myself (the flap tab) or my referent (the flap body)."
+ 
+ 	anObject == self ifTrue: [^ super positionObject: anObject atEdgeOf: container].  "The tab itself"
+ 
+ 	(#(top left) includes: edgeToAdhereTo) ifTrue:
+ 		[^ anObject topLeft: container innerBounds topLeft].
+ 
+ 	(edgeToAdhereTo = #bottom) ifTrue:
+ 		[^ anObject bottomLeft: container innerBounds bottomLeft].
+ 
+ 	anObject topRight: container innerBounds topRight!

Item was added:
+ InteriorFlapTab subclass: #InteriorSolidSugarSuppliesTab
+ 	instanceVariableNames: 'sugarNavBar'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !InteriorSolidSugarSuppliesTab commentStamp: 'sw 9/3/2007 04:19' prior: 0!
+ A "solid" flap tab used in conjunction with the sugar supplies bin used on the interior of an event theatre.!

Item was added:
+ ----- Method: InteriorSolidSugarSuppliesTab>>addCustomMenuItems:hand: (in category 'nil') -----
+ addCustomMenuItems: aMenu hand: aHand
+ 	"Overridden in order to thwart super."
+ 
+ !

Item was added:
+ ----- Method: InteriorSolidSugarSuppliesTab>>adjustPositionAfterHidingFlap (in category 'show & hide') -----
+ adjustPositionAfterHidingFlap
+ 	"The flap has has been hidden; adjust the tab's position.  In this case, the tab reduces to zero height."
+ 
+ 	super adjustPositionAfterHidingFlap.
+ 	self setProperty: #heightWhenOpen toValue: self height.
+ 	self height: 0	!

Item was added:
+ ----- Method: InteriorSolidSugarSuppliesTab>>arrangeToPopOutOnDragOver: (in category 'initialization') -----
+ arrangeToPopOutOnDragOver: aBoolean
+ 	"Set up the receiver with the right dragover properties."
+ 
+ 	aBoolean
+ 		ifTrue:
+ 			[referent on: #mouseLeaveDragging send: #maybeHideFlapOnMouseLeaveDragging to: self.
+ 			self on: #mouseLeaveDragging send: #maybeHideFlapOnMouseLeaveDragging to: self]
+ 		ifFalse:
+ 			[self on: #mouseEnterDragging send: nil to: nil.
+ 			referent on: #mouseLeaveDragging send: nil to: nil.
+ 			self on: #mouseLeaveDragging send: nil to: nil]!

Item was added:
+ ----- Method: InteriorSolidSugarSuppliesTab>>fitOnScreen (in category 'positioning') -----
+ fitOnScreen
+ 	"19 sept 2000 - allow flaps in any paste up"
+ 	| constrainer t l |
+ 	constrainer _ owner ifNil: [self].
+ 	self flapShowing "otherwise no point in doing this"
+ 		ifTrue:[self spanWorld].
+ 	self orientation == #vertical ifTrue: [
+ 		t _ ((self top min: (constrainer bottom- self height)) max: constrainer top).
+ 		t = self top ifFalse: [self top: t].
+ 	] ifFalse: [
+ 		l _ ((self left min: (constrainer right - self width)) max: constrainer left).
+ 		l = self left ifFalse: [self left: l].
+ 	].
+ 	self flapShowing ifFalse: [self positionObject: self atEdgeOf: constrainer].
+ 
+ !

Item was added:
+ ----- Method: InteriorSolidSugarSuppliesTab>>initialize (in category 'initialization') -----
+ initialize
+ 	"Set up the receiver to have a solid tab."
+ 
+ 	super initialize.
+ 	self beSticky!

Item was added:
+ ----- Method: InteriorSolidSugarSuppliesTab>>mouseMove: (in category 'event handling') -----
+ mouseMove: evt
+ 	"Handle a mouse-move within the solid tab."
+ 
+ 	| aPosition newReferentThickness adjustedPosition thick aWorldlet |
+ 	dragged ifFalse: [(thick _ self referentThickness) > 0
+ 		ifTrue: [lastReferentThickness _ thick]].
+ 
+ 	aWorldlet := self ownerThatIsA: Worldlet.
+ 	aPosition := evt cursorPoint - aWorldlet position.
+ 	edgeToAdhereTo == #top
+ 		ifTrue:
+ 			[adjustedPosition _ aPosition - evt hand targetOffset.
+ 			newReferentThickness _ adjustedPosition y - self navBarHeight]
+ 		ifFalse:
+ 			[adjustedPosition := aPosition - evt hand targetOffset.
+ 			newReferentThickness := aWorldlet height - (adjustedPosition y + self navBarHeight + self height)].
+ 
+ 	self applyThickness: newReferentThickness.
+ 	dragged _ true.
+ 	self fitOnScreen!

Item was added:
+ ----- Method: InteriorSolidSugarSuppliesTab>>navBarHeight (in category 'mechanics') -----
+ navBarHeight
+ 	"Answer the height of the nav-bar of the evt theatre with which the receiver is associated."
+ 
+ 	^ sugarNavBar height!

Item was added:
+ ----- Method: InteriorSolidSugarSuppliesTab>>naviHeight: (in category 'initialization') -----
+ naviHeight: anInteger
+ 	"Set the navigator height."
+ 
+ 	submorphs ifEmpty: [^ self].
+ 	submorphs first extent: anInteger at anInteger.
+ !

Item was added:
+ ----- Method: InteriorSolidSugarSuppliesTab>>positionObject:atEdgeOf: (in category 'mechanics') -----
+ positionObject: anObject atEdgeOf: container
+ 	"Position an object -- either the receiver or its referent -- on the edge of the container."
+ 
+ 	| extra |
+ 	extra := self navBarHeight - 2.
+ 	edgeToAdhereTo == #top
+ 		ifTrue:
+ 			[anObject top: container top + extra]
+ 		ifFalse: 
+ 			[anObject bottom: (container bottom - extra)] !

Item was added:
+ ----- Method: InteriorSolidSugarSuppliesTab>>showFlap (in category 'show & hide') -----
+ showFlap
+ 	"Open the flap up"
+ 
+ 	self height: (self valueOfProperty: #heightWHenOpen ifAbsent: [20]).
+ 	super showFlap!

Item was added:
+ ----- Method: InteriorSolidSugarSuppliesTab>>spanWorld (in category 'positioning') -----
+ spanWorld
+ 	"Make the receiver's width commensurate with that of the container."
+ 
+ 	super spanWorld.
+ 	self width:  self pasteUpMorph width!

Item was added:
+ ----- Method: InteriorSolidSugarSuppliesTab>>sugarNavBar: (in category 'accessing') -----
+ sugarNavBar: aBar
+ 	"Establish the value of the sugarNavBar instance variable."
+ 
+ 	sugarNavBar := aBar!

Item was added:
+ ----- Method: InteriorSolidSugarSuppliesTab>>wantsToBeTopmost (in category 'mechanics') -----
+ wantsToBeTopmost
+ 	"Answer if the receiver want to be one of the topmost objects in its owner"
+ 
+ 	^ self flapShowing
+ !

Item was added:
+ SugarNavigatorBar subclass: #InteriorSugarNavBar
+ 	instanceVariableNames: 'edgeToAdhereTo'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !InteriorSugarNavBar commentStamp: 'sw 8/12/2007 01:25' prior: 0!
+ Used for the "fake sugar navigator bar" that optionally appears at the top of an Event Theatre.!

Item was added:
+ ----- Method: InteriorSugarNavBar>>addButtons (in category 'initialization') -----
+ addButtons
+ 	"Add the sugar buttons, delimited on each end by spacers."
+ 
+ 	self addTransparentSpacerOfSize: 30 at 1.
+ 	super addButtons.
+ 	self addTransparentSpacerOfSize: 30 at 1!

Item was added:
+ ----- Method: InteriorSugarNavBar>>addCustomMenuItems:hand: (in category 'menus') -----
+ addCustomMenuItems: aMenu hand: aHandMorph
+ 	"Add further items to the menu as appropriate"
+ 
+ 	aMenu addLine.
+ 	aMenu addUpdating: #edgeString action: #setEdgeToAdhereTo.
+ 	aMenu add: 'destroy this flap' translated action: #destroyFlap.
+ 
+ 	aMenu addLine.
+ 
+ 	aMenu add: 'use default green look' translated action: #makeGreen.
+ 	aMenu add: 'use default gray look' translated action: #makeGray.
+ 	aMenu add: 'color...' translated target: self action: #changeColor.
+ 	aMenu add: 'highlight color...' translated target: self action: #changeHighlightColor.
+ 	aMenu add: 'height...' translated target: self action: #changeNaviHeight.
+ !

Item was added:
+ ----- Method: InteriorSugarNavBar>>adhereToEdge: (in category 'accessing') -----
+ adhereToEdge: aSymbol
+ 	"Set the value of edgeToAdhereTo, and position the receiver accordingly"
+ 
+ 	edgeToAdhereTo := aSymbol.
+ 	super adhereToEdge: aSymbol.
+ 	supplies ifNotNil: [supplies setEdge: aSymbol]!

Item was added:
+ ----- Method: InteriorSugarNavBar>>changeColor (in category 'morphic interaction') -----
+ changeColor
+ 	"Change the color of the receiver -- triggered, e.g. from a menu"
+ 
+ 	ColorPickerMorph new
+ 		choseModalityFromPreference;
+ 		sourceHand: self activeHand;
+ 		target: self;
+ 		selector: #color:;
+ 		originalColor: color;
+ 		putUpFor: self near: self fullBoundsInWorld!

Item was added:
+ ----- Method: InteriorSugarNavBar>>changeHighlightColor (in category 'events') -----
+ changeHighlightColor
+ 	"Put up a color picker allowing the user to select a highlight color."
+ 
+ 	ColorPickerMorph new
+ 		choseModalityFromPreference;
+ 		sourceHand: self activeHand;
+ 		target: self;
+ 		selector: #highLightColor:;
+ 		originalColor: self color;
+ 		putUpFor: self near: self fullBoundsInWorld!

Item was added:
+ ----- Method: InteriorSugarNavBar>>changeNaviHeight (in category 'events') -----
+ changeNaviHeight
+ 	"Allow the user to choose a new height for the navigator."
+ 
+ 	| f n |
+ 	f _ FillInTheBlank request: 'new height of the bar'  translated initialAnswer: self height asString.
+ 	n _ f asNumber min: (self pasteUpMorph height // 2) max: 0.
+ 	self naviHeight: n.!

Item was added:
+ ----- Method: InteriorSugarNavBar>>checkForResize (in category 'morphic interaction') -----
+ checkForResize
+ 	"Called during the step, make sure I conform to my owner's width."
+ 
+ 	self width: owner width!

Item was added:
+ ----- Method: InteriorSugarNavBar>>chooseLanguage (in category 'buttons') -----
+ chooseLanguage
+ 	"If I have a language button, make it inoperative."
+ !

Item was added:
+ ----- Method: InteriorSugarNavBar>>destroyFlap (in category 'button actions') -----
+ destroyFlap
+ 	"Simply delete the receiver."
+ 
+ 	self delete!

Item was added:
+ ----- Method: InteriorSugarNavBar>>doNewPainting (in category 'buttons') -----
+ doNewPainting
+ 	"Make a new painting"
+ 
+ 	| worldlet aRect |
+ 	ActiveWorld assureNotPaintingElse: [^ self].
+ 	worldlet _ self ownerThatIsA: Worldlet.
+ 	aRect := (worldlet topLeft + (0 @ self height)) corner: worldlet bottomRight.
+ 	worldlet makeNewDrawing: (ActiveHand lastEvent copy setPosition: aRect center)!

Item was added:
+ ----- Method: InteriorSugarNavBar>>edgeString (in category 'edge') -----
+ edgeString
+ 	"Answer a string characterizing the edge to which I cling."
+ 
+ 	^ 'cling to edge... (current: {1})' translated format: {edgeToAdhereTo translated}!

Item was added:
+ ----- Method: InteriorSugarNavBar>>edgeToAdhereTo (in category 'accessing') -----
+ edgeToAdhereTo
+ 	"Answer the value of edgeToAdhereTo"
+ 
+ 	^ edgeToAdhereTo!

Item was added:
+ ----- Method: InteriorSugarNavBar>>findAProjectSimple (in category 'buttons') -----
+ findAProjectSimple
+ 	"But don't..."!

Item was added:
+ ----- Method: InteriorSugarNavBar>>finishInitialization (in category 'initialization') -----
+ finishInitialization
+ 	"After the receiver is added at its proper place in the hierarchy, this needs to be called."
+ 
+ 	self addButtons.
+ 	self adhereToEdge: #top.
+ 	self setNameTo: 'Navigator Flap' translated
+ !

Item was added:
+ ----- Method: InteriorSugarNavBar>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver."
+ 
+ 	| |
+ 	super initialize.
+ 	self listDirection: #leftToRight.
+ 	self cellInset: 10 at 8.
+ 	self layoutInset: 6 at 0.
+ 	self hResizing: #spaceFill.
+ 	self vResizing: #rigid. 
+ 	self height: 75.
+ 	self color: ( Color r: 0.258 g: 0.258 b: 0.258).
+ 	self adhereToEdge: #top.!

Item was added:
+ ----- Method: InteriorSugarNavBar>>keepProject (in category 'buttons') -----
+ keepProject
+ 	"But don't..."!

Item was added:
+ ----- Method: InteriorSugarNavBar>>makeTheSimpleButtons (in category 'initialization') -----
+ makeTheSimpleButtons
+ 	"Add the buttons for use in normal kids' mode."
+ 
+ 	^{
+ 		self buttonPaint.
+ 		self buttonSupplies.
+ 		"self buttonUndo."
+ 		#spacer.
+ 
+ 			}!

Item was added:
+ ----- Method: InteriorSugarNavBar>>newProject (in category 'buttons') -----
+ newProject
+ 	"But don't..."
+ !

Item was added:
+ ----- Method: InteriorSugarNavBar>>previousProject (in category 'buttons') -----
+ previousProject
+ 	"But don't..."!

Item was added:
+ ----- Method: InteriorSugarNavBar>>publishProject (in category 'buttons') -----
+ publishProject
+ 	"But don't..."!

Item was added:
+ ----- Method: InteriorSugarNavBar>>resizeButtonsAndTabTo: (in category 'morphic interaction') -----
+ resizeButtonsAndTabTo: newDim
+ 	"The user has chosen a new height for the nav bar; make the buttons follow suit."
+ 
+ 	| frame wantsSupplies |
+ 	wantsSupplies := supplies notNil and: [supplies flapShowing].
+ 	wantsSupplies ifTrue: [supplies hideFlap].
+ 	frame _ paintButton owner.
+ 	frame submorphs do: [:e |
+ 		e naviHeight: newDim].
+ 	frame height: newDim.
+ 	self height: newDim.
+ 	wantsSupplies ifTrue: [supplies showFlap]!

Item was added:
+ ----- Method: InteriorSugarNavBar>>setEdgeToAdhereTo (in category 'edge') -----
+ setEdgeToAdhereTo
+ 	"Put up a menu allowing user to specify the edge."
+ 
+ 	| aMenu |
+ 	aMenu _ MenuMorph new defaultTarget: self.
+ 	#(top bottom) do:
+ 		[:sym | aMenu add: sym asString translated target: self selector:  #adhereToEdge: argument: sym].
+ 	aMenu popUpEvent: self currentEvent in: self world!

Item was added:
+ ----- Method: InteriorSugarNavBar>>setupSuppliesFlap (in category 'initialization') -----
+ setupSuppliesFlap
+ 	"Set up the interior supplies flap."
+ 
+ 	supplies := (self ownerThatIsA: EventRecordingSpace) sugarSuppliesFlapTab.
+ 	self pasteUpMorph addMorphFront: supplies.
+ 	^ supplies!

Item was added:
+ ----- Method: InteriorSugarNavBar>>shareThisWorld (in category 'buttons') -----
+ shareThisWorld
+ 	"If I have a share button, make it inoperative."!

Item was added:
+ ----- Method: InteriorSugarNavBar>>step (in category 'morphic interaction') -----
+ step
+ 	"thwart efforts of superclass."
+ 
+ 	self checkForResize!

Item was added:
+ ----- Method: InteriorSugarNavBar>>stopSqueak (in category 'buttons') -----
+ stopSqueak
+ 	"But don't..."!

Item was added:
+ ----- Method: InteriorSugarNavBar>>toggleSupplies (in category 'button actions') -----
+ toggleSupplies
+ 	"Toggle the whether the interior supplies flap is open."
+ 
+ 	| ref aFlapTab |
+ 	aFlapTab _ self pasteUpMorph flapTabs
+ 				detect: [:s | (s isKindOf: FlapTab)
+ 						and: [s flapID = 'Supplies' translated]]
+ 				ifNone: [self setupSuppliesFlap].
+ 	ref _ aFlapTab referent.
+ 	ref isInWorld
+ 		ifTrue:
+ 			[aFlapTab hideFlap]
+ 		ifFalse:
+ 			[aFlapTab showFlap.
+ 			(owner notNil and: [owner isFlapTab])
+ 				ifTrue: [owner edgeToAdhereTo == #top
+ 						ifTrue: [ref position: self bottomLeft].
+ 					owner edgeToAdhereTo == #bottom
+ 						ifTrue: [ref bottomLeft: self topLeft]]]!

Item was added:
+ ----- Method: InteriorSugarNavBar>>undoOrRedoLastCommand (in category 'buttons') -----
+ undoOrRedoLastCommand
+ 	"For now we let this be alive..."
+ 
+ 	^ super undoOrRedoLastCommand!

Item was added:
+ ----- Method: InteriorSugarNavBar>>wantsHaloFromClick (in category 'morphic interaction') -----
+ wantsHaloFromClick
+ 	"Answer that I would take a halo from a click..."
+ 
+ 	^ true
+ !

Item was added:
+ InteriorFlapTab subclass: #InteriorSugarSuppliesTab
+ 	instanceVariableNames: 'sugarNavBar'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !InteriorSugarSuppliesTab commentStamp: 'sw 9/1/2007 02:22' prior: 0!
+ DISUSED...  Superseded by InteriorSolidSugarSuppliesTab.  Retained for a while for backward compatability, in consideration of existing content.
+ 
+ A flap-tab for the the *fake* fake Sugar supplies flap at the top of an event-recording theatre or event-playback theatre.
+ 
+ Because this object cannot inherit both from InteriorFlapTab and from SugarSuppliesTab, it inherits only from the former, with  code copied over from the latter as needed.!

Item was added:
+ ----- Method: InteriorSugarSuppliesTab>>arrangeToPopOutOnDragOver: (in category 'initialization') -----
+ arrangeToPopOutOnDragOver: aBoolean
+ 	"See to it that I do or don't pop out on drag-over, as per the boolean.  Copied over directly from the SugarSuppliesTab method of the same name."
+ 
+ 	aBoolean
+ 		ifTrue:
+ 			[
+ 			referent on: #mouseLeaveDragging send: #maybeHideFlapOnMouseLeaveDragging to: self.
+ 			self on: #mouseLeaveDragging send: #maybeHideFlapOnMouseLeaveDragging to: self]
+ 		ifFalse:
+ 			[self on: #mouseEnterDragging send: nil to: nil.
+ 			referent on: #mouseLeaveDragging send: nil to: nil.
+ 			self on: #mouseLeaveDragging send: nil to: nil]!

Item was added:
+ ----- Method: InteriorSugarSuppliesTab>>naviHeight: (in category 'initialization') -----
+ naviHeight: anInteger
+ 	"Accept the argument as the height of the navigator.  Copied over from SugarSuppliesTab method of the same name."
+ 
+ 	submorphs ifEmpty: [^ self].
+ 	submorphs first extent: anInteger at anInteger.
+ !

Item was added:
+ ----- Method: InteriorSugarSuppliesTab>>positionObject:atEdgeOf: (in category 'positioning') -----
+ positionObject: anObject atEdgeOf: container
+ 	"Position the object supplied at the edge of the container supplied."
+ 
+ 	| extra |
+ 	extra _ (sugarNavBar notNil and: [referent isInWorld]) ifTrue: [sugarNavBar height] ifFalse: [0].
+ 	edgeToAdhereTo == #top ifTrue:
+ 		[^ anObject top: container innerBounds top + extra].
+ 	edgeToAdhereTo == #bottom ifTrue: 
+ 		[^ anObject bottom: container innerBounds bottom - extra]
+ !

Item was added:
+ ----- Method: InteriorSugarSuppliesTab>>sugarNavBar:icon: (in category 'initialization') -----
+ sugarNavBar: aBar icon: aForm
+ 	"Associate the receiver with the given sugar-nav-bar."
+ 
+ 	sugarNavBar _  aBar.
+ 	aForm ifNotNil:
+ 		[self useTextualTab.
+ 		self setProperty: #priorGraphic toValue: aForm.
+ 		self useGraphicalTab].
+ !

Item was added:
+ ----- Method: InteriorSugarSuppliesTab>>wantsToBeTopmost (in category 'positioning') -----
+ wantsToBeTopmost
+ 	"If my flap is showing, then force me to be topmost."
+ 
+ 	^ self flapShowing
+ !

Item was added:
+ ----- Method: InternalThreadNavigationMorph>>resetBottomRightPosition (in category '*Etoys-Squeakland-menu') -----
+ resetBottomRightPosition
+ 
+ 	ActiveWorld removeProperty: #threadNavigatorPosition.
+ !

Item was added:
+ ----- Method: InternalThreadNavigationMorph>>setBottomRightPosition (in category '*Etoys-Squeakland-menu') -----
+ setBottomRightPosition
+ 
+ 	ActiveWorld setProperty: #threadNavigatorPosition toValue: self bottomRight.
+ !

Item was added:
+ ----- Method: Interval>>hashMappedBy: (in category '*Etoys-Squeakland-comparing') -----
+ hashMappedBy: map
+ 	"My hash is independent of my oop."
+ 
+ 	^self hash!

Item was added:
+ ----- Method: Interval>>start (in category '*Etoys-Squeakland-accessing') -----
+ start
+ 	^ start!

Item was added:
+ ----- Method: Interval>>stop (in category '*Etoys-Squeakland-accessing') -----
+ stop
+ 	^ stop!

Item was added:
+ TextConverter subclass: #KOI8RTextConverter
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'FromTable'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-TextConversion'!

Item was added:
+ ----- Method: KOI8RTextConverter class>>encodingNames (in category 'as yet unclassified') -----
+ encodingNames 
+ 
+ 	^ #('koi8-r') copy
+ !

Item was added:
+ ----- Method: KOI8RTextConverter class>>initialize (in category 'as yet unclassified') -----
+ initialize
+ "
+ 	KOI8RTextConverter initialize
+ "
+ 	FromTable _ Dictionary new.
+ 	FromTable at: 16r2500 put: 16r80.
+ 	FromTable at: 16r2502 put: 16r81.
+ 	FromTable at: 16r250C put: 16r82.
+ 	FromTable at: 16r2510 put: 16r83.
+ 	FromTable at: 16r2514 put: 16r84.
+ 	FromTable at: 16r2518 put: 16r85.
+ 	FromTable at: 16r251C put: 16r86.
+ 	FromTable at: 16r2524 put: 16r87.
+ 	FromTable at: 16r252C put: 16r88.
+ 	FromTable at: 16r2534 put: 16r89.
+ 	FromTable at: 16r253C put: 16r8A.
+ 	FromTable at: 16r2580 put: 16r8B.
+ 	FromTable at: 16r2584 put: 16r8C.
+ 	FromTable at: 16r2588 put: 16r8D.
+ 	FromTable at: 16r258C put: 16r8E.
+ 	FromTable at: 16r2590 put: 16r8F.
+ 	FromTable at: 16r2591 put: 16r90.
+ 	FromTable at: 16r2592 put: 16r91.
+ 	FromTable at: 16r2593 put: 16r92.
+ 	FromTable at: 16r2320 put: 16r93.
+ 	FromTable at: 16r25A0 put: 16r94.
+ 	FromTable at: 16r2219 put: 16r95.
+ 	FromTable at: 16r221A put: 16r96.
+ 	FromTable at: 16r2248 put: 16r97.
+ 	FromTable at: 16r2264 put: 16r98.
+ 	FromTable at: 16r2265 put: 16r99.
+ 	FromTable at: 16r00A0 put: 16r9A.
+ 	FromTable at: 16r2321 put: 16r9B.
+ 	FromTable at: 16r00B0 put: 16r9C.
+ 	FromTable at: 16r00B2 put: 16r9D.
+ 	FromTable at: 16r00B7 put: 16r9E.
+ 	FromTable at: 16r00F7 put: 16r9F.
+ 	FromTable at: 16r2550 put: 16rA0.
+ 	FromTable at: 16r2551 put: 16rA1.
+ 	FromTable at: 16r2552 put: 16rA2.
+ 	FromTable at: 16r0451 put: 16rA3.
+ 	FromTable at: 16r2553 put: 16rA4.
+ 	FromTable at: 16r2554 put: 16rA5.
+ 	FromTable at: 16r2555 put: 16rA6.
+ 	FromTable at: 16r2556 put: 16rA7.
+ 	FromTable at: 16r2557 put: 16rA8.
+ 	FromTable at: 16r2558 put: 16rA9.
+ 	FromTable at: 16r2559 put: 16rAA.
+ 	FromTable at: 16r255A put: 16rAB.
+ 	FromTable at: 16r255B put: 16rAC.
+ 	FromTable at: 16r255C put: 16rAD.
+ 	FromTable at: 16r255D put: 16rAE.
+ 	FromTable at: 16r255E put: 16rAF.
+ 	FromTable at: 16r255F put: 16rB0.
+ 	FromTable at: 16r2560 put: 16rB1.
+ 	FromTable at: 16r2561 put: 16rB2.
+ 	FromTable at: 16r0401 put: 16rB3.
+ 	FromTable at: 16r2562 put: 16rB4.
+ 	FromTable at: 16r2563 put: 16rB5.
+ 	FromTable at: 16r2564 put: 16rB6.
+ 	FromTable at: 16r2565 put: 16rB7.
+ 	FromTable at: 16r2566 put: 16rB8.
+ 	FromTable at: 16r2567 put: 16rB9.
+ 	FromTable at: 16r2568 put: 16rBA.
+ 	FromTable at: 16r2569 put: 16rBB.
+ 	FromTable at: 16r256A put: 16rBC.
+ 	FromTable at: 16r256B put: 16rBD.
+ 	FromTable at: 16r256C put: 16rBE.
+ 	FromTable at: 16r00A9 put: 16rBF.
+ 	FromTable at: 16r044E put: 16rC0.
+ 	FromTable at: 16r0430 put: 16rC1.
+ 	FromTable at: 16r0431 put: 16rC2.
+ 	FromTable at: 16r0446 put: 16rC3.
+ 	FromTable at: 16r0434 put: 16rC4.
+ 	FromTable at: 16r0435 put: 16rC5.
+ 	FromTable at: 16r0444 put: 16rC6.
+ 	FromTable at: 16r0433 put: 16rC7.
+ 	FromTable at: 16r0445 put: 16rC8.
+ 	FromTable at: 16r0438 put: 16rC9.
+ 	FromTable at: 16r0439 put: 16rCA.
+ 	FromTable at: 16r043A put: 16rCB.
+ 	FromTable at: 16r043B put: 16rCC.
+ 	FromTable at: 16r043C put: 16rCD.
+ 	FromTable at: 16r043D put: 16rCE.
+ 	FromTable at: 16r043E put: 16rCF.
+ 	FromTable at: 16r043F put: 16rD0.
+ 	FromTable at: 16r044F put: 16rD1.
+ 	FromTable at: 16r0440 put: 16rD2.
+ 	FromTable at: 16r0441 put: 16rD3.
+ 	FromTable at: 16r0442 put: 16rD4.
+ 	FromTable at: 16r0443 put: 16rD5.
+ 	FromTable at: 16r0436 put: 16rD6.
+ 	FromTable at: 16r0432 put: 16rD7.
+ 	FromTable at: 16r044C put: 16rD8.
+ 	FromTable at: 16r044B put: 16rD9.
+ 	FromTable at: 16r0437 put: 16rDA.
+ 	FromTable at: 16r0448 put: 16rDB.
+ 	FromTable at: 16r044D put: 16rDC.
+ 	FromTable at: 16r0449 put: 16rDD.
+ 	FromTable at: 16r0447 put: 16rDE.
+ 	FromTable at: 16r044A put: 16rDF.
+ 	FromTable at: 16r042E put: 16rE0.
+ 	FromTable at: 16r0410 put: 16rE1.
+ 	FromTable at: 16r0411 put: 16rE2.
+ 	FromTable at: 16r0426 put: 16rE3.
+ 	FromTable at: 16r0414 put: 16rE4.
+ 	FromTable at: 16r0415 put: 16rE5.
+ 	FromTable at: 16r0424 put: 16rE6.
+ 	FromTable at: 16r0413 put: 16rE7.
+ 	FromTable at: 16r0425 put: 16rE8.
+ 	FromTable at: 16r0418 put: 16rE9.
+ 	FromTable at: 16r0419 put: 16rEA.
+ 	FromTable at: 16r041A put: 16rEB.
+ 	FromTable at: 16r041B put: 16rEC.
+ 	FromTable at: 16r041C put: 16rED.
+ 	FromTable at: 16r041D put: 16rEE.
+ 	FromTable at: 16r041E put: 16rEF.
+ 	FromTable at: 16r041F put: 16rF0.
+ 	FromTable at: 16r042F put: 16rF1.
+ 	FromTable at: 16r0420 put: 16rF2.
+ 	FromTable at: 16r0421 put: 16rF3.
+ 	FromTable at: 16r0422 put: 16rF4.
+ 	FromTable at: 16r0423 put: 16rF5.
+ 	FromTable at: 16r0416 put: 16rF6.
+ 	FromTable at: 16r0412 put: 16rF7.
+ 	FromTable at: 16r042C put: 16rF8.
+ 	FromTable at: 16r042B put: 16rF9.
+ 	FromTable at: 16r0417 put: 16rFA.
+ 	FromTable at: 16r0428 put: 16rFB.
+ 	FromTable at: 16r042D put: 16rFC.
+ 	FromTable at: 16r0429 put: 16rFD.
+ 	FromTable at: 16r0427 put: 16rFE.
+ 	FromTable at: 16r042A put: 16rFF.
+ !

Item was added:
+ ----- Method: KOI8RTextConverter>>fromSqueak: (in category 'as yet unclassified') -----
+ fromSqueak: char
+ 
+ 	^ Character value: (FromTable at: char charCode ifAbsent: [char asciiValue])!

Item was added:
+ ----- Method: KOI8RTextConverter>>nextFromStream: (in category 'as yet unclassified') -----
+ nextFromStream: aStream
+ 
+ 	| character1 |
+ 	aStream isBinary ifTrue: [^ aStream basicNext].
+ 	character1 _ aStream basicNext.
+ 	character1 isNil ifTrue: [^ nil].
+ 	^ self toSqueak: character1.
+ !

Item was added:
+ ----- Method: KOI8RTextConverter>>nextPut:toStream: (in category 'as yet unclassified') -----
+ nextPut: aCharacter toStream: aStream
+ 
+ 	aStream isBinary ifTrue: [^aCharacter storeBinaryOn: aStream].
+ 	aCharacter charCode < 128 ifTrue: [
+ 		aStream basicNextPut: aCharacter.
+ 	] ifFalse: [
+ 		aStream basicNextPut: ((Character value: (self fromSqueak: aCharacter) charCode)).
+ 	].
+ !

Item was added:
+ ----- Method: KOI8RTextConverter>>toSqueak: (in category 'as yet unclassified') -----
+ toSqueak: char
+ 
+ 	| value |
+ 	value _ char charCode.
+ 
+ 	value < 128 ifTrue: [^ char].
+ 	value > 255 ifTrue: [^ char].
+ 	^ Character leadingChar: RussianEnvironment leadingChar code: (#(
+ 		16r2500 16r2502 16r250C 16r2510 16r2514 16r2518 16r251C 16r2524
+ 		16r252C 16r2534 16r253C 16r2580 16r2584 16r2588 16r258C 16r2590
+ 		16r2591 16r2592 16r2593 16r2320 16r25A0 16r2219 16r221A 16r2248
+ 		16r2264 16r2265 16r00A0 16r2321 16r00B0 16r00B2 16r00B7 16r00F7
+ 		16r2550 16r2551 16r2552 16r0451 16r2553 16r2554 16r2555 16r2556
+ 		16r2557 16r2558 16r2559 16r255A 16r255B 16r255C 16r255D 16r255E
+ 		16r255F 16r2560 16r2561 16r0401 16r2562 16r2563 16r2564 16r2565
+ 		16r2566 16r2567 16r2568 16r2569 16r256A 16r256B 16r256C 16r00A9
+ 		16r044E 16r0430 16r0431 16r0446 16r0434 16r0435 16r0444 16r0433
+ 		16r0445 16r0438 16r0439 16r043A 16r043B 16r043C 16r043D 16r043E
+ 		16r043F 16r044F 16r0440 16r0441 16r0442 16r0443 16r0436 16r0432
+ 		16r044C 16r044B 16r0437 16r0448 16r044D 16r0449 16r0447 16r044A
+ 		16r042E 16r0410 16r0411 16r0426 16r0414 16r0415 16r0424 16r0413
+ 		16r0425 16r0418 16r0419 16r041A 16r041B 16r041C 16r041D 16r041E
+ 		16r041F 16r042F 16r0420 16r0421 16r0422 16r0423 16r0416 16r0412
+ 		16r042C 16r042B 16r0417 16r0428 16r042D 16r0429 16r0427 16r042A
+ ) at: (value - 128 + 1)).
+ !

Item was added:
+ Object subclass: #KedamaAttributeDefnition
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tweak-Kedama-ParseTree-AttributeDefinition'!

Item was added:
+ ----- Method: KedamaAttributeDefnition class>>attributeDefinition (in category 'as yet unclassified') -----
+ attributeDefinition
+ 
+ 	^ #().
+ 	"#((CParseNode #const #synth))"
+ 	"
+ 	-> 
+ 	evaluator defineAttributeNamed: #const at: CParseNode type: #synth.
+ "!

Item was added:
+ ----- Method: KedamaAttributeDefnition class>>generateAttributeDefinitionInput (in category 'as yet unclassified') -----
+ generateAttributeDefinitionInput
+ 
+ 	| attrs |
+ 	attrs _ self attributeDefinition, #((MethodNode #start #intrinsic)).
+ 
+ 	^ String streamContents: [:strm |
+ 		attrs do: [:line |
+ 			strm nextPutAll: ('self defineAttributeNamed: #{1} at: {2} type: #{3}.' format: {line second. (Smalltalk at: line first). line third}).
+ 		].
+ 		strm nextPutAll: 'self generateInstVarAndAccessors.'
+ 	].
+ !

Item was added:
+ ----- Method: KedamaAttributeDefnition class>>generateEvaluatorCreationString (in category 'as yet unclassified') -----
+ generateEvaluatorCreationString
+ 
+ 	^ ''.
+ !

Item was added:
+ ----- Method: KedamaAttributeDefnition class>>generateEvaluatorInput (in category 'as yet unclassified') -----
+ generateEvaluatorInput
+ 
+ 	^ self generateEvaluatorCreationString,
+ 	 self generateAttributeDefinitionInput,
+ 	self generateSemanticRuleSignatureInput.
+ !

Item was added:
+ ----- Method: KedamaAttributeDefnition class>>generateSemanticRuleSignatureInput (in category 'as yet unclassified') -----
+ generateSemanticRuleSignatureInput
+ 
+ 	| sigs inputs inputString encodeStream |
+ 	sigs _ self semanticRuleSignatures, #((start MethodNode initialNil #())).
+ 
+ 
+ 	^ String streamContents: [:strm |
+ 		sigs do: [:line |
+ 			encodeStream _ WriteStream on: String new.
+ 			inputs _ line fourth.
+ 			inputString _ String streamContents: [:in |
+ 				in nextPutAll: '{'.
+ 				inputs do: [:input |
+ 					in nextPutAll: ('(InputSpec new attributeName: #{1}; type: #{2}; yourself). ' format: input).
+ 				].
+ 				in nextPutAll: '}'.
+ 			].
+ 			(self class sourceCodeAt: line third) asString do: [:c | encodeStream nextPut: c. c = $' ifTrue: [encodeStream nextPut: c.]].
+ 			strm nextPutAll: ('self
+ 				defineSemanticRuleFor: (ParseNodeAttribute new attributeName: #{1}; grammarClass: {2}; yourself)
+ 				rule: ''{3}''
+ 				selector: #{4}
+ 				uses: {5}.' format: {line first. line second. encodeStream contents. line third. inputString}).
+ 			strm cr.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: KedamaAttributeDefnition class>>semanticRuleSignatures (in category 'as yet unclassified') -----
+ semanticRuleSignatures
+ 
+ 	^ #().
+ 
+ 	"^ #(
+ 		#(const CParseNode mergeConst: #((const allChildrenSynt)))
+ 		#(const CLeafNode initialConst #())
+ 		#(const CSelectorNode selectorConst #()))."
+ 
+ !

Item was added:
+ Object subclass: #KedamaAttributeEvaluator
+ 	instanceVariableNames: 'symbolClasses declaredAttributes attributes intrinsicSemanticRules semanticRules parseTree attributedTree receiver dependencies references'
+ 	classVariableNames: 'Debug Default'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tweak-Kedama-ParseTreeTransformer'!

Item was added:
+ ----- Method: KedamaAttributeEvaluator class>>clearGeneratedMethodsFrom: (in category 'as yet unclassified') -----
+ clearGeneratedMethodsFrom: rootClass
+ "
+ 	self clearGeneratedMethodsFrom: ParseNode
+ "
+ 	(rootClass allSubclasses copyWith: rootClass) do: [:cls |
+ 		#('*Etoys-Tweak-Kedama-Generated' '*Etoys-Tweak-Kedama-accessing') do: [:cat |
+ 			(cls organization listAtCategoryNamed: cat) do: [:sel |
+ 				cls removeSelectorSilently: sel.
+ 			]
+ 		].
+ 	].
+ 	"(ParseNode organization listAtCategoryNamed: 'accessing') do: [:sel |
+ 		ParseNode removeSelectorSilently: sel
+ 	].
+ "
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator class>>clearInstVarFrom:except: (in category 'as yet unclassified') -----
+ clearInstVarFrom: rootClass except: aCollection
+ "
+ 	self clearInstVarFrom: ParseNode except: #('comment' 'pc').
+ "
+ 	| instVars |
+ 	instVars _ rootClass instVarNames select: [:var |
+ 		(aCollection includes: var) not.
+ 	].
+ 	rootClass removeInstVarNames: instVars. 
+ 	
+ 	(rootClass organization listAtCategoryNamed: 'accessing') do: [:sel |
+ 		rootClass removeSelectorSilently: sel
+ 	].
+ 
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator class>>default (in category 'as yet unclassified') -----
+ default
+ 
+ 	^ Default
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator class>>setDefault: (in category 'as yet unclassified') -----
+ setDefault: anObject
+ 
+ 	Default _ anObject.
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator class>>setDefaultEvaluator (in category 'as yet unclassified') -----
+ setDefaultEvaluator
+ "
+ 	self setDefaultEvaluator
+ "
+ "	| evaluator |
+ 	evaluator _ KedamaAttributeEvaluator new.
+ 	evaluator defineSyntaxFrom: KedamaAttributeEvaluator tweakTileParseNodes.
+ 	evaluator readDefinitionsFrom: KedamaTurtleDefinition.
+ 	KedamaAttributeEvaluator setDefault: evaluator.
+ 	evaluator compileEvaluator.
+ "!

Item was added:
+ ----- Method: KedamaAttributeEvaluator class>>squeakParseNodes (in category 'as yet unclassified') -----
+ squeakParseNodes
+ 
+ 	^ {
+ 	{ParseNode.			#().					false}.
+ 	{AssignmentNode. 	#(variable value).	false}.
+ 	{BlockNode.		#(arguments statements).false}.
+ 	{BraceNode.		#(elements).			false}.
+ 	{CascadeNode.		#(receiver messages). false}.
+ 	{CommentNode.		#(). true}.
+ 	{LeafNode.		#(key).	true}.
+ 	{LiteralNode.		#(). true}.
+ 	{SelectorNode.		#(). true}.
+ 	{VariableNode.		#(name). true}.
+ 	{LiteralVariableNode.	#(). true}.
+ 	{TempVariableNode.	#(). true}.
+ 	{MessageNode.		#(receiver selector arguments). false}.
+ 	{MessageAsTempNode.	#(). false}.
+ 	{MethodNode.		#(selectorOrFalse arguments block). false}.
+ 	{MethodTempsNode.	#(). false}.
+ 	{ReturnNode.		#(expr). false}.
+ }!

Item was added:
+ ----- Method: KedamaAttributeEvaluator class>>tweakTileParseNodes (in category 'as yet unclassified') -----
+ tweakTileParseNodes
+ 
+ 	^ {
+ "	{CTilePlayer.			#().					false}.
+ 	{CMessageLikeTile.	#().						false}.
+ 	{CAssignmentTile. 	#(property expression operator).	false}.
+ 	{CBlockTile. 			#(arguments temporaries statements).	false}.
+ 	{CMessageTile.		#(arguments receiver selector).	false}.
+ 	{COperatorTile.		#(arguments receiver selector).	false}.
+ 	{CPropertyTile.		#(property receiver). 	false}.
+ 	{CSequenceTile.		#(arguments temporaries statements). false}.
+ 	{CScriptorTile.		#(arguments temporaries statements).	false}.
+ 	{CSeparatorTile.		#(). true}.
+ 	{CValueTile.			#(). true}.
+ 	{CLeafVariableTile.			#(). true}.
+ 	{CVariableTile.		#(expression). false}."
+ }!

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>addGraphEdgesAt:andParent: (in category 'private') -----
+ addGraphEdgesAt: parseNode andParent: parentNode
+ 
+ 	| deps occurrences rule |
+ 	occurrences _ parseNode xxxOccurences.
+ 	occurrences do: [:oc |
+ 		rule _ self selectRuleFor: oc at: parseNode andParent: parentNode.
+ 		rule ifNil: [self error: 'no applicable rule found'].
+ 		oc selectedRule: rule.
+ 		rule inputSpecs size = 0 ifTrue: [oc outTime: 0].
+ 		"oc attributeName = #isTopStatement ifTrue: [self halt]."
+ 		rule inputSpecs do: [:inputSpec |
+ 			deps _ self addGraphEdgesAt: parseNode andParent: parentNode fromRule: rule forInputSpec: inputSpec.
+ 			deps size > 0 ifTrue: [
+ 				self addToDependencies: deps.
+ 				oc inputSizeAt: (rule inputSpecs indexOf: inputSpec) put: ((inputSpec type == #allChildrenSynth) ifTrue: [Array with: deps size] ifFalse: [1]).
+ 			].
+ 		].
+ 	].
+ 	parseNode isLeaf ifFalse: [
+ 		parseNode getAllChildren do: [:child |
+ 			self addGraphEdgesAt: child andParent: parseNode.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>addGraphEdgesAt:andParent:fromRule:forInputSpec: (in category 'private') -----
+ addGraphEdgesAt: parseNode andParent: parentNode fromRule: rule forInputSpec: inputSpec
+ 
+ 	| type |
+ 	type _ inputSpec type.
+ 
+ 	type == #intrinsic ifTrue: [
+ 		^ #().
+ 	].
+ 	type == #myInh ifTrue: [
+ 		^ self makeGraphEdgesAt: parseNode andParent: parentNode forMyInhRule: rule inputSpec: inputSpec.
+ 	].
+ 	type == #mySynth ifTrue: [
+ 		^ self makeGraphEdgesAt: parseNode andParent: parentNode forMySynthRule: rule inputSpec: inputSpec.
+ 	].
+ 	type == #parentInh ifTrue: [
+ 		^ self makeGraphEdgesAt: parseNode andParent: parentNode forParentInhRule: rule inputSpec: inputSpec.
+ 	].
+ 	type == #allChildrenSynth ifTrue: [
+ 		^ self makeGraphEdgesAt: parseNode andParent: parentNode forAllChildSynthRule: rule inputSpec: inputSpec.
+ 	].
+ 	type == #parentInhFirstChild ifTrue: [
+ 		^ self makeGraphEdgesAt: parseNode andParent: parentNode forFirstChildInhRule: rule inputSpec: inputSpec.
+ 	].
+ 	type == #elderSiblingSynth ifTrue: [
+ 		^ self makeGraphEdgesAt: parseNode andParent: parentNode forElderSiblingInhRule: rule inputSpec: inputSpec.
+ 	].
+ 	type == #lastChildSynth ifTrue: [
+ 		^ self makeGraphEdgesAt: parseNode andParent: parentNode forLastChildSynthRule: rule inputSpec: inputSpec.
+ 	].
+ 	type == #parentSynth ifTrue: [
+ 		^ self makeGraphEdgesAt: parseNode andParent: parentNode forParentSynthRule: rule inputSpec: inputSpec.
+ 	].
+ 
+ 
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>addGraphEdgesRoot (in category 'actions') -----
+ addGraphEdgesRoot
+ 
+ 	dependencies _ IdentityDictionary new.
+ 	self addGraphEdgesAt: parseTree andParent: nil.
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>addRule:forAttribute: (in category 'private') -----
+ addRule: rule forAttribute: anAttribute
+ 
+ 	(intrinsicSemanticRules at: anAttribute grammarClass) addFirst: rule.
+ 	(anAttribute grammarClass allSubclasses copyWith: anAttribute grammarClass) do: [:c |
+ 		(symbolClasses includes: c) ifTrue: [
+ 			(semanticRules at: c) addFirst: rule.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>addToDependencies: (in category 'private') -----
+ addToDependencies: deps
+ 
+ 	| src dst list |
+ 	deps do: [:pair |
+ 		src _ ((pair at: 1) at: 2) perform: ((pair at: 1) at: 1).
+ 		dst _ ((pair at: 2) at: 2) perform: ((pair at: 2) at: 1).
+ 		list _ dependencies at: src ifAbsentPut: [WriteStream on: (Array new: 8)].
+ 		list nextPut: dst.
+ 		dst addSource: src.
+ 	].
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>attributeDefinitionsOf: (in category 'private') -----
+ attributeDefinitionsOf: grammarClass
+ 
+ 	^ attributes at: grammarClass ifAbsent: [#()].
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>attributedTree (in category 'accessing') -----
+ attributedTree
+ 
+ 	^ attributedTree.
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>clearReferences (in category 'actions') -----
+ clearReferences
+ 
+ 	parseTree _ nil.
+ 	attributedTree _ nil.
+ 	receiver _ nil..
+ 	dependencies _ nil.
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>compileEvaluator (in category 'actions') -----
+ compileEvaluator
+ 
+ 	| meth |
+ 	semanticRules associationsDo: [:assoc |
+ 		assoc value do: [:rule |
+ 			meth _ rule ruleText.
+ 			Debug == true ifTrue: [
+ 				Transcript show: assoc key name; cr; show: meth; cr.
+ 			].
+ 			assoc key compileSilently: meth classified: '*Etoys-Tweak-Kedama-Generated'.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>debug: (in category 'accessing') -----
+ debug: aBoolean
+ 
+ 	Debug _ aBoolean
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>defineAttributeNamed:at:type: (in category 'input definitions') -----
+ defineAttributeNamed: attrName at: grammarClass type: inhOrSynth
+ 
+ 	| attr |
+ 
+ 	grammarClass withAllSubclassesDo: [:c |
+ 		attr := ParseNodeAttribute new.
+ 		attr grammarClass: c.
+ 		attr attributeName: attrName.
+ 		attr type: inhOrSynth.
+ 		(symbolClasses includes: c) ifTrue: [
+ 			(attributes at: c) at: attrName asSymbol put: attr.
+ 		].
+ 	].
+ 	declaredAttributes at: grammarClass ifAbsentPut: [OrderedCollection new].
+ 	(declaredAttributes at: grammarClass) add: attrName.
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>defineSemanticRuleFor:rule:selector:uses: (in category 'input definitions') -----
+ defineSemanticRuleFor: anAttribute rule: aString selector: selector uses: inputSpecs
+ 
+ 	| rule  |
+ 	inputSpecs do: [:spec |
+ 		(#(parentInh parentSynth parentInhFirstChild elderSiblingSynth lastChildSynth mySynth myInh allChildrenSynth intrinsic) includes: spec type) ifFalse: [^ self error: 'wrong input specification'].
+ 	].
+ 	rule _ AttributeSemanticRule new.
+ 	rule output: anAttribute.
+ 	rule inputSpecs: inputSpecs.
+ 	rule ruleText: aString.
+ 
+ "
+ 	selector _ String streamContents: [:strm |
+ 		strm nextPutAll: anAttribute attributeName.
+ 		inputSpecs do: [:in |
+ 			strm nextPutAll: in uniqueName.
+ 			strm nextPutAll: ':'.
+ 		].
+ 	].
+ "
+ 
+ 	rule selector: selector asSymbol.
+ 	(anAttribute grammarClass allSubclasses copyWith: anAttribute grammarClass) do: [:c |
+ 		(symbolClasses includes: c) ifTrue: [
+ 			((attributes at: c) at: anAttribute attributeName) addRule: rule.
+ 		].
+ 	].
+ 
+ 	self addRule: rule forAttribute: anAttribute.
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>defineSyntaxFrom: (in category 'input definitions') -----
+ defineSyntaxFrom: list
+ 
+ 	symbolClasses _ OrderedCollection new.
+ 	list do: [:triple |
+ 		symbolClasses add: triple first.
+ 	].
+ 
+ 	symbolClasses _ symbolClasses asArray.
+ 	attributes _ IdentityDictionary new.
+ 	semanticRules _ IdentityDictionary new.
+ 	intrinsicSemanticRules _ IdentityDictionary new.
+ 	symbolClasses do: [:t |
+ 		attributes at: t put: IdentityDictionary new.
+ 		semanticRules at: t put: OrderedCollection new.
+ 		intrinsicSemanticRules at: t put: OrderedCollection new.
+ 	].
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>evaluateAllOccurence (in category 'actions') -----
+ evaluateAllOccurence
+ 
+ 	self sortDependencies do: [:x | self evaluateOccurence: x].
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>evaluateOccurence: (in category 'private') -----
+ evaluateOccurence: occurence
+ 
+ 	"pick the attribute from the occurence at parseNode."
+ 	"check the dependency for that occurence."
+ 	"if they are not evaluated, recursively call itself with new arguments."
+ 	"if all the values are evaluated, #perform: the registered method with these values."
+ 
+ 	| ret n args realArgs |
+ 	n _ occurence node.
+ 	args _ ReadStream on: (occurence dependencies collect: [:oc | oc value]).
+ 	realArgs _ Array new: 0.
+ 	occurence inputSizes do: [:s |
+ 		s isCollection ifTrue: [
+ 			realArgs _ realArgs copyWith: (args next: (s at: 1)).
+ 		] ifFalse: [
+ 			realArgs _ realArgs copyWith: args next.
+ 		].
+ 	].
+ 			
+ 	(n = parseTree and: [occurence selectedRule selector = #rcvr]) ifTrue: [
+ 		ret _ receiver
+ 	] ifFalse: [
+ 		ret _ n perform: occurence selectedRule selector withArguments: realArgs.
+ 	].
+ 	Debug == true ifTrue: [
+ 		Transcript show: n printString, ' ', occurence selectedRule selector, ' ', args printString, ' ', realArgs printString, ' ', ret printString; cr.
+ 	].
+ 	occurence value: ret.
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>generateInstVarAndAccessor:forGrammarClass: (in category 'private') -----
+ generateInstVarAndAccessor: attrName forGrammarClass: grammarClass
+ 
+ 	| newMessage |
+ 	newMessage _ attrName, '
+ 	"Answer the value of ', attrName, '"
+ 
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #', attrName, ') value'.
+ 		grammarClass compileSilently: newMessage classified: '*Etoys-Tweak-Kedama-accessing' notifying: nil.
+ 
+ 		newMessage _ 'raw', attrName, '
+ 	"Answer the value of ', attrName, '"
+ 
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #', attrName.
+ 		grammarClass compileSilently: newMessage classified: '*Etoys-Tweak-Kedama-accessing' notifying: nil.
+ 
+ 		newMessage _ attrName, ':', ' anObject
+ 	"Set the value of ', attrName, '"
+ 
+ 	KedamaEvaluatorNodeState stateFor: self at: #', attrName, ' put: anObject'.
+ 		grammarClass compileSilently: newMessage classified: '*Etoys-Tweak-Kedama-accessing' notifying: nil
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>generateInstVarAndAccessors (in category 'private') -----
+ generateInstVarAndAccessors
+ 
+ 	declaredAttributes keysDo: [:cls |
+ 		self generateInstVarAndAccessorsForGrammarClass: cls
+ 	].
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>generateInstVarAndAccessorsForGrammarClass: (in category 'private') -----
+ generateInstVarAndAccessorsForGrammarClass: grammarClass
+ 
+ 	| attrs |
+ 	attrs _ declaredAttributes at: grammarClass ifAbsent: [#()].
+ 	grammarClass = ParseNode ifTrue: [attrs _ attrs copyWith: #xxxOccurences].
+ 	"tfel: We no longer add inst vars to the class, to allow clean loading and unloading of Etoys. We instead keep the instance specific
+ 	state in a weak dictionary on a special class singleton"
+ 	attrs do: [:attrName |
+ 		KedamaEvaluatorNodeState dictionary at: attrName put: WeakIdentityKeyDictionary new.
+ 		self generateInstVarAndAccessor: attrName forGrammarClass: grammarClass
+ 	].
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>initialize (in category 'initialize-release') -----
+ initialize
+ 
+ 	declaredAttributes _ Dictionary new.
+ 	references _ IdentityDictionary new.
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>isApplicable:at:andParent: (in category 'private') -----
+ isApplicable: rule at: parseNode andParent: parentNode
+ 
+ 	rule inputSpecs size = 0 ifTrue: [^ true].
+ 	rule inputSpecs collect: [:spec |
+ 		(self matchSpec: spec at: parseNode andParent: parentNode) ifFalse: [^ false].
+ 	].
+ 	^ true.
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>makeAttributedTreeWith:forReceiver: (in category 'actions') -----
+ makeAttributedTreeWith: aParseTree forReceiver: anObject
+ 
+ 	parseTree _ aParseTree normalize.
+ 	attributedTree _ AttributeVisitor new.
+ 	attributedTree newWith: parseTree for: self.
+ 	receiver _ anObject.
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>makeDependencyEdgeFromAttribute:at:toAttribute:at: (in category 'private') -----
+ makeDependencyEdgeFromAttribute: fromAttr at: fromNode toAttribute: toAttr at: toNode
+ 
+ 	^ Array with: ((Array with: fromAttr with: fromNode))
+ 				with: ((Array with: toAttr with: toNode)).
+ "
+ 	^ Array with: (attributedTree attribute: fromAttr at: fromNode)
+ 				with: (attributedTree attribute: toAttr at: toNode).
+ 
+ "!

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>makeGraphEdgesAt:andParent:forAllChildSynthRule:inputSpec: (in category 'private') -----
+ makeGraphEdgesAt: parseNode andParent: parentNode forAllChildSynthRule: semanticRule inputSpec: inputSpec
+ 
+ 	| outName inName ret |
+ 
+ 	inName _ inputSpec rawGetter.
+ 	outName _ semanticRule output rawGetter.
+ 
+ 	parseNode isLeaf ifTrue: [
+ 		^ #().
+ 	].
+ 
+ 	ret _ WriteStream on: (Array new: 4).
+ 	parseNode getAllChildren do: [:childNode |
+ 		ret nextPut: (Array with: (Array with: inName with: childNode)
+ 							with: (Array with: outName with: parseNode)).
+ 	].
+ 	^ ret contents.
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>makeGraphEdgesAt:andParent:forElderSiblingInhRule:inputSpec: (in category 'private') -----
+ makeGraphEdgesAt: parseNode andParent: parentNode forElderSiblingInhRule: semanticRule inputSpec: inputSpec
+ 
+ 	| inName outName elder |
+ 	inName _ inputSpec rawGetter.
+ 	outName _ semanticRule output rawGetter.
+ 
+ 	parentNode ifNil: [
+ 		^ #().
+ 	].
+ 
+ 	(parentNode isFirstChild: parseNode) ifTrue: [
+ 		^ #().
+ 	] ifFalse: [
+ 		elder _ parentNode getElderSiblingOf: parseNode.
+ 		^ Array with: (self makeDependencyEdgeFromAttribute: inName at: elder toAttribute: outName at: parseNode).
+ 	].
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>makeGraphEdgesAt:andParent:forFirstChildInhRule:inputSpec: (in category 'private') -----
+ makeGraphEdgesAt: parseNode andParent: parentNode forFirstChildInhRule: semanticRule inputSpec: inputSpec
+ 
+ 	| inName outName |
+ 	inName _ inputSpec rawGetter.
+ 	outName _ semanticRule output rawGetter.
+ 
+ 	parentNode ifNil: [
+ 		^ #().
+ 	].
+ 
+ 	(parentNode isFirstChild: parseNode) ifTrue: [
+ 		^ Array with: (self makeDependencyEdgeFromAttribute: inName at: parentNode toAttribute: outName at: parseNode).
+ 	] ifFalse: [
+ 		^ #().
+ 	].
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>makeGraphEdgesAt:andParent:forLastChildSynthRule:inputSpec: (in category 'private') -----
+ makeGraphEdgesAt: parseNode andParent: parentNode forLastChildSynthRule: semanticRule inputSpec: inputSpec
+ 
+ 	| inName outName child |
+ 	inName _ inputSpec rawGetter.
+ 	outName _ semanticRule output rawGetter.
+ 
+ 	parseNode isLeaf ifTrue: [
+ 		^ #().
+ 	].
+ 
+ 	(child _ parseNode getLastChild) ifNotNil: [
+ 		^ Array with: (self makeDependencyEdgeFromAttribute: inName at: child toAttribute: outName at: parseNode).
+ 	] ifNil: [
+ 		^ #().
+ 	].
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>makeGraphEdgesAt:andParent:forMyInhRule:inputSpec: (in category 'private') -----
+ makeGraphEdgesAt: parseNode andParent: parentNode forMyInhRule: semanticRule inputSpec: inputSpec
+ 
+ 	| inName outName |
+ 	inName _ inputSpec rawGetter.
+ 	outName _ semanticRule output rawGetter.
+ 
+ 	^ Array with: (self makeDependencyEdgeFromAttribute: inName at: parseNode toAttribute: outName at: parseNode).
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>makeGraphEdgesAt:andParent:forMySynthRule:inputSpec: (in category 'private') -----
+ makeGraphEdgesAt: parseNode andParent: parentNode forMySynthRule: semanticRule inputSpec: inputSpec
+ 
+ 	| inName outName |
+ 	inName _ inputSpec rawGetter.
+ 	outName _ semanticRule output rawGetter.
+ 
+ 	^ Array with: (self makeDependencyEdgeFromAttribute: inName at: parseNode toAttribute: outName at: parseNode).
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>makeGraphEdgesAt:andParent:forParentInhRule:inputSpec: (in category 'private') -----
+ makeGraphEdgesAt: parseNode andParent: parentNode forParentInhRule: semanticRule inputSpec: inputSpec
+ 
+ 	| inName outName |
+ 	inName _ inputSpec rawGetter.
+ 	outName _ semanticRule output rawGetter.
+ 
+ 	parentNode ifNil: ["root"
+ 		^ #().
+ 	].
+ 
+ 	^ Array with: (self makeDependencyEdgeFromAttribute: inName at: parentNode toAttribute: outName at: parseNode).
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>makeGraphEdgesAt:andParent:forParentSynthRule:inputSpec: (in category 'private') -----
+ makeGraphEdgesAt: parseNode andParent: parentNode forParentSynthRule: semanticRule inputSpec: inputSpec
+ 
+ 	| inName outName |
+ 	inName _ inputSpec rawGetter.
+ 	outName _ semanticRule output rawGetter.
+ 
+ 	parentNode ifNil: ["root"
+ 		^ #().
+ 	].
+ 
+ 	^ Array with: (self makeDependencyEdgeFromAttribute: inName at: parentNode toAttribute: outName at: parseNode).
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>matchSpec:at:andParent: (in category 'private') -----
+ matchSpec: spec at: parseNode andParent: parentNode
+ 
+ 	| inName type |
+ 	inName _ spec attributeName.
+ 	type _ spec type.
+ 
+ 	type = #parentInh ifTrue: [
+ 		^ parentNode notNil "(and: [self node: parentNode hasAttribute: inName])"
+ 	].
+ 	type = #parentSynth ifTrue: [
+ 		^ parentNode notNil "(and: [self node: parentNode hasAttribute: inName])"
+ 	].
+ 	type = #allChildrenSynth ifTrue: [
+ 		^ parseNode isLeaf not.
+ 	].
+ 	type = #parentInhFirstChild ifTrue: [
+ 		^ parentNode notNil and: [parentNode isFirstChild: parseNode].
+ 	].
+ 	type = #elderSiblingSynth ifTrue: [
+ 		^ parentNode notNil and: [(parentNode isFirstChild: parseNode) not].
+ 	].
+ 	type = #lastChildSynth ifTrue: [
+ 		^ parseNode isLeaf not and: [parseNode getLastChild notNil].
+ 	].
+ 	type = #myInh ifTrue: [
+ 		^ true.
+ 	].
+ 	type = #mySynth ifTrue: [
+ 		^ true.
+ 	].
+ 	type = #intrinsic ifTrue: [
+ 		^ true.
+ 	].
+ 	^ false.
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>parseTree (in category 'accessing') -----
+ parseTree
+ 
+ 	^ parseTree.
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>readDefinitionsFrom: (in category 'input definitions') -----
+ readDefinitionsFrom: aClass
+ 
+ 	Compiler evaluate: aClass generateEvaluatorInput for: self notifying: nil logged: false.
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>selectRuleFor:at:andParent: (in category 'private') -----
+ selectRuleFor: occurence at: parseNode andParent: parentNode
+ 
+ 	occurence rules do: [:rule |
+ 		(self isApplicable: rule at: parseNode andParent: parentNode) ifTrue: [^ rule].
+ 	].
+ 	^ nil.
+ !

Item was added:
+ ----- Method: KedamaAttributeEvaluator>>sortDependencies (in category 'actions') -----
+ sortDependencies
+ 
+ 	| t keys array |
+ 	t _ TopologicalSorter new.
+ 	keys _ attributedTree allOccurences contents.
+ 	dependencies fasterKeys do: [:key |
+ 		array _ (dependencies at: key) contents.
+ 		dependencies at: key put: array.
+ 	].
+ 	t collection: keys.
+ 	t edges: dependencies.
+ 	^ t sort.
+ !

Item was added:
+ Object subclass: #KedamaEvaluatorNodeState
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tweak-Kedama-ParseTreeTransformer'!
+ KedamaEvaluatorNodeState class
+ 	instanceVariableNames: 'dictionary'!
+ KedamaEvaluatorNodeState class
+ 	instanceVariableNames: 'dictionary'!

Item was added:
+ ----- Method: KedamaEvaluatorNodeState class>>dictionary (in category 'accessing') -----
+ dictionary
+ 
+ 	^ dictionary!

Item was added:
+ ----- Method: KedamaEvaluatorNodeState class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"self initialize"
+ 	dictionary := IdentityDictionary new!

Item was added:
+ ----- Method: KedamaEvaluatorNodeState class>>new (in category 'instance creation') -----
+ new
+ 
+ 	self error: 'This class is not meant to be instantianted'!

Item was added:
+ ----- Method: KedamaEvaluatorNodeState class>>stateFor:at: (in category 'state access') -----
+ stateFor: anInstance at: aVariableName
+ 
+ 	^ (self dictionary at: aVariableName) at: anInstance ifAbsentPut: [nil]!

Item was added:
+ ----- Method: KedamaEvaluatorNodeState class>>stateFor:at:put: (in category 'state access') -----
+ stateFor: anInstance at: aVariableName put: anObject
+ 
+ 	^ (self dictionary at: aVariableName) at: anInstance put: anObject!

Item was changed:
  ----- Method: KedamaExamplerPlayer class>>isUniClass (in category 'compiling') -----
  isUniClass
+ 
+ 	^ self ~~ self officialClass!
- 	"Uni-classes end with digits"
- 	^self name endsWithDigit!

Item was added:
+ ----- Method: KedamaExamplerPlayer class>>officialClass (in category 'all') -----
+ officialClass
+ 
+ 	^ KedamaExamplerPlayer!

Item was added:
+ ----- Method: KedamaExamplerPlayer>>acceptScript:for: (in category 'method management') -----
+ acceptScript: aScriptEditorMorph for: aSelector
+ 	"Accept the tile code in the script editor as the code for the given selector.  This branch is only for the classic-tile system, 1997-2001"
+ 	| aUniclassScript str node |
+ 	(aScriptEditorMorph generateParseNodeDirectly and: [(node _ aScriptEditorMorph methodNode) notNil]) ifTrue: [
+ 		str _ node printString.
+ 		self class compileSilently: str classified: 'scripts' for: self.
+ 		turtles class compileSilently: str classified: 'scripts' for: self.
+ 		sequentialStub class compileSilently: str classified: 'scripts' for: self.
+ 	] ifFalse: [
+ 		str _ aScriptEditorMorph methodString.
+ 		self class compileSilently: str classified: 'scripts' for: self.
+ 		turtles class compileSilently: str classified: 'scripts' for: self.
+ 		sequentialStub class compileSilently: str classified: 'scripts' for: self.
+ 	].
+ 	aUniclassScript _ self class assuredMethodInterfaceFor: aSelector asSymbol.
+ 	aUniclassScript currentScriptEditor: aScriptEditorMorph.
+ 	aScriptEditorMorph world ifNotNil: [aScriptEditorMorph world removeHighlightFeedback].
+ !

Item was changed:
  ----- Method: KedamaExamplerPlayer>>addInstanceVarNamed:withValue: (in category 'player protocol') -----
  addInstanceVarNamed: aName withValue: aValue
  
  	self basicAddInstanceVarNamed: aName withValue: aValue.
+ 	"turtles _ kedamaWorld turtlesOf: self."
+ 	turtles addInstanceVarNamed: aName withValue: aValue.
- 	"turtles := kedamaWorld turtlesOf: self."
- 	turtles addInstanceVarVectorNamed: aName withValue: aValue.
  !

Item was added:
+ ----- Method: KedamaExamplerPlayer>>areOkaySelectors: (in category '*Etoys-Squeakland-testing') -----
+ areOkaySelectors: aCollection
+ 
+ 	aCollection do: [:sel | 
+ 		(#(= & |  + - * / \\ // ifTrue:ifFalse:) includes: sel) ifFalse: [^ false].
+ 	].
+ 	^ true.
+ !

Item was added:
+ ----- Method: KedamaExamplerPlayer>>containsBreedSelectors: (in category '*Etoys-Squeakland-private') -----
+ containsBreedSelectors: collection
+ 
+ 	collection do: [:e |
+ 		(#(setTurtleCount: setGrouped:) includes: e) ifTrue: [^ true].
+ 	].
+ 	^ false.
+ !

Item was added:
+ ----- Method: KedamaExamplerPlayer>>containsSequentialSelector: (in category '*Etoys-Squeakland-private') -----
+ containsSequentialSelector: aSymbol
+ 
+ 	^ (#(random random:) includes: aSymbol)!

Item was added:
+ ----- Method: KedamaExamplerPlayer>>containsSequentialSelectors: (in category '*Etoys-Squeakland-private') -----
+ containsSequentialSelectors: collection
+ 
+ 	collection do: [:e |
+ 		(self containsSequentialSelector: e) ifTrue: [^ true].
+ 	].
+ 	^ false.
+ 
+ !

Item was added:
+ ----- Method: KedamaExamplerPlayer>>copyAllMethodsAgain2 (in category '*Etoys-Squeakland-debug support') -----
+ copyAllMethodsAgain2
+ 
+ 	| c result |
+ 	c _ turtles class.
+ 	result _ (ClassBuilder new)
+ 		name: c name
+ 		inEnvironment: c environment
+ 		subclassOf: c superclass
+ 		type: c typeOfClass
+ 		instanceVariableNames: KedamaTurtleVectorPlayer2 instanceVariablesString
+ 		classVariableNames: KedamaTurtleVectorPlayer2 classVariablesString
+ 		poolDictionaries: KedamaTurtleVectorPlayer2 sharedPoolsString
+ 		category: Object categoryForUniclasses.
+ 	turtles class copyAllCategoriesUnobtrusivelyFrom: KedamaTurtleVectorPlayer2.
+ 	sequentialStub ifNotNil: [sequentialStub class copyAllCategoriesUnobtrusivelyFrom: KedamaSequenceExecutionStub].
+ !

Item was added:
+ ----- Method: KedamaExamplerPlayer>>createTurtles2 (in category '*Etoys-Squeakland-subclass players management') -----
+ createTurtles2
+ 
+ 	turtles _ self class createTurtleSubclass2 new.
+ 	turtles kedamaWorld: kedamaWorld.
+ 	turtles exampler: self.
+ 	^ turtles.
+ !

Item was changed:
  ----- Method: KedamaExamplerPlayer>>doSequentialCommand: (in category 'command execution') -----
  doSequentialCommand: aBlock
  
+ 	| ret pred |
+ 	ret _ self doExamplerCommand: aBlock.
- 	| ret |
- 	ret := self doExamplerCommand: aBlock.
  	self getGrouped ifFalse: [
+ 		pred _ turtles arrays at: 7.
  		1 to: turtles size do: [:i |
+ 			(pred at: i) = 1 ifTrue: [
+ 				sequentialStub index: i.
+ 				aBlock value: sequentialStub.
+ 			].
- 			sequentialStub index: i.
- 			aBlock value: sequentialStub.
  		].
  	] ifTrue: [
  		aBlock value: turtles.
  	].
  	turtles invalidateTurtleMap.
  	^ ret.
  
  !

Item was added:
+ ----- Method: KedamaExamplerPlayer>>isBreedSelector: (in category '*Etoys-Squeakland-private') -----
+ isBreedSelector: aSymbol
+ 
+ 	^ #(getTurtleCount setTurtleCount: setGrouped: getGrouped) includes: aSymbol.
+ !

Item was added:
+ ----- Method: KedamaExamplerPlayer>>isUserDefinedSelector: (in category '*Etoys-Squeakland-testing') -----
+ isUserDefinedSelector: aSymbol
+ 
+ 	^ self class superclass scripts notNil and: [self class superclass scripts includes: aSymbol].!

Item was added:
+ ----- Method: KedamaExamplerPlayer>>removeScriptNamed: (in category '*Etoys-Squeakland-method management') -----
+ removeScriptNamed: aScriptName
+ 
+ 	super removeScriptNamed: aScriptName.
+ 	turtles class removeSelectorSilently: aScriptName.
+ 	sequentialStub class removeSelectorSilently: aScriptName.
+ !

Item was changed:
  ----- Method: KedamaExamplerPlayer>>removeSlotNamed: (in category 'player protocol') -----
  removeSlotNamed: aSlotName
  
  	self basicRemoveSlotNamed: aSlotName.
  	turtles removeVectorSlotNamed: aSlotName.
+ 	sequentialStub removeSlotNamed: aSlotName.
  !

Item was added:
+ ----- Method: KedamaExamplerPlayer>>userDefinedSlotGetters (in category '*Etoys-Squeakland-private') -----
+ userDefinedSlotGetters
+ 
+ 	^ turtles info keys asArray collect: [:e | Utilities getterSelectorFor: e].
+ !

Item was added:
+ ----- Method: KedamaExamplerPlayer>>userDefinedSlotSetters (in category '*Etoys-Squeakland-private') -----
+ userDefinedSlotSetters
+ 
+ 	^ turtles info keys asArray collect: [:e | Utilities setterSelectorFor: e].
+ !

Item was added:
+ ----- Method: KedamaExamplerPlayer>>vectorizableTheseSelectors: (in category '*Etoys-Squeakland-private') -----
+ vectorizableTheseSelectors: collection
+ 
+ 	| removed scripts |
+ 	scripts _ self class scripts keys.
+ 	removed _ collection reject: [:e | (scripts includes: e) or: [#(getTurtleCount setTurtleCount: setGrouped: getGrouped) includes: e]].
+ 	removed do: [:e |
+ 		((#(getX setX: getY setY: setColor: getColor getVisible setVisible: getTurtleVisible setTurtleVisible: getHeading setHeading: getAngleTo: getDistanceTo: getUphillIn: forward: turn: setPatchValueIn:to: beNotZero: getPatchValueIn:),
+ 		self userDefinedSlotGetters,
+ 		self userDefinedSlotSetters) includes: e) ifFalse: [^ false].
+ 	].
+ 	^ true.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>\\ (in category 'arithmetic') -----
+ \\ other
+ 
+ 	| result |
+ 	other isNumber ifTrue: [
+ 		result _ KedamaFloatArray new: self size.
+ 		^ self primRemScalar: self and: other into: result.
+ 	].
+ 	((other isMemberOf: WordArray) or: [other isMemberOf: KedamaFloatArray]) ifTrue: [	
+ 		result _ KedamaFloatArray new: self size.
+ 		^ self primRemArray: self and: other into: result.
+ 	].
+ 	^ super \\ other.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>eToysEQ: (in category 'arithmetic') -----
+ eToysEQ: other
+ 
+ 	| result |
+ 	result _ ByteArray new: self size.
+ 	other isNumber ifTrue: [
+ 		^ self primEQScalar: self and: other into: result.
+ 	].
+ 	((other isMemberOf: WordArray) or: [other isMemberOf: KedamaFloatArray]) ifTrue: [	
+ 		^ self primEQArray: self and: other into: result.
+ 	].
+ 	1 to: self size do: [:index |
+ 		result at: index put: (self at: index) = (other at: index).
+ 	].
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>eToysGE: (in category 'arithmetic') -----
+ eToysGE: other
+ 
+ 	| result |
+ 	result _ ByteArray new: self size.
+ 	other isNumber ifTrue: [
+ 		^ self primGEScalar: self and: other into: result.
+ 	].
+ 	((other isMemberOf: WordArray) or: [other isMemberOf: KedamaFloatArray]) ifTrue: [	
+ 		^ self primGEArray: self and: other into: result.
+ 	].
+ 	^ super >= other.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>eToysGT: (in category 'arithmetic') -----
+ eToysGT: other
+ 
+ 	| result |
+ 	result _ ByteArray new: self size.
+ 	other isNumber ifTrue: [
+ 		^ self primGTScalar: self and: other into: result.
+ 	].
+ 	((other isMemberOf: WordArray) or: [other isMemberOf: KedamaFloatArray]) ifTrue: [	
+ 		^ self primGTArray: self and: other into: result.
+ 	].
+ 	^ super > other.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>eToysLE: (in category 'arithmetic') -----
+ eToysLE: other
+ 
+ 	| result |
+ 	result _ ByteArray new: self size.
+ 	other isNumber ifTrue: [
+ 		^ self primLEScalar: self and: other into: result.
+ 	].
+ 	((other isMemberOf: WordArray) or: [other isMemberOf: KedamaFloatArray]) ifTrue: [	
+ 		^ self primLEArray: self and: other into: result.
+ 	].
+ 	^ super <= other.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>eToysLT: (in category 'arithmetic') -----
+ eToysLT: other
+ 
+ 	| result |
+ 	result _ ByteArray new: self size.
+ 	other isNumber ifTrue: [
+ 		^ self primLTScalar: self and: other into: result.
+ 	].
+ 	((other isMemberOf: WordArray) or: [other isMemberOf: KedamaFloatArray]) ifTrue: [	
+ 		^ self primLTArray: self and: other into: result.
+ 	].
+ 	^ super < other.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>eToysNE: (in category 'arithmetic') -----
+ eToysNE: other
+ 
+ 	| result |
+ 	result _ ByteArray new: self size.
+ 	other isNumber ifTrue: [
+ 		^ self primNEScalar: self and: other into: result.
+ 	].
+ 	((other isMemberOf: WordArray) or: [other isMemberOf: KedamaFloatArray]) ifTrue: [	
+ 		^ self primNEArray: self and: other into: result.
+ 	].
+ 	1 to: self size do: [:index |
+ 		result at: index put: (self at: index) ~= (other at: index).
+ 	].
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>isDivisibleBy: (in category '*Etoys-Squeakland-arithmetic') -----
+ isDivisibleBy: other
+ 
+ 	| result |
+ 	result _ ByteArray new: self size.
+ 	other isNumber ifTrue: [
+ 		^ self primDVScalar: self and: other into: result.
+ 	].
+ 	((other isMemberOf: WordArray) or: [other isMemberOf: KedamaFloatArray]) ifTrue: [	
+ 		^ self primDVArray: self and: other into: result.
+ 	].
+ 	^ super < other.
+ !

Item was changed:
  ----- Method: KedamaFloatArray>>primAddArray:and:into: (in category 'primitives') -----
  primAddArray: rcvr and: other into: result
  
+ 	<primitive: 'primitiveAddArrays' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveAddArrays."
- 	<primitive: 'primitiveAddArrays' module:'KedamaPlugin'>
- 	"^ KedamaPlugin doPrimitive: #primitiveAddArrays."
  
  	1 to: rcvr size do: [:i |
  		result at: i put: (rcvr at: i) + (other at: i)
  	].
  	^ result.
  !

Item was changed:
  ----- Method: KedamaFloatArray>>primAddScalar:and:into: (in category 'primitives') -----
  primAddScalar: rcvr and: other into: result
  
+ 	<primitive: 'primitiveAddScalar' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveAddScalar."
- 	<primitive: 'primitiveAddScalar' module:'KedamaPlugin'>
- 	"^ KedamaPlugin doPrimitive: #primitiveAddScalar."
  
  	1 to: rcvr size do: [:i |
  		result at: i put: (rcvr at: i) + other.
  	].
  	^ result.
  !

Item was added:
+ ----- Method: KedamaFloatArray>>primDVArray:and:into: (in category '*Etoys-Squeakland-primitives') -----
+ primDVArray: rcvr and: other into: result
+ 
+ 	"<primitive: 'primitiveDVArrays' module:'KedamaPlugin2'>"
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveDVArrays."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: (((rcvr at: i) isDivisibleBy: (other at: i)) ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>primDVScalar:and:into: (in category '*Etoys-Squeakland-primitives') -----
+ primDVScalar: rcvr and: other into: result
+ 
+ 	"<primitive: 'primitiveDVScalar' module:'KedamaPlugin2'>"
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveDVScalar."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: (((rcvr at: i) isDivisibleBy: other) ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ 
+ 
+ !

Item was changed:
  ----- Method: KedamaFloatArray>>primDivArray:and:into: (in category 'primitives') -----
  primDivArray: rcvr and: other into: result
  
+ 	<primitive: 'primitiveDivArrays' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveDivArrays."
- 	<primitive: 'primitiveDivArrays' module:'KedamaPlugin'>
- 	"^ KedamaPlugin doPrimitive: #primitiveDivArrays."
  
  	1 to: rcvr size do: [:i |
  		result at: i put: (rcvr at: i) / (other at: i)
  	].
  	^ result.
  !

Item was changed:
  ----- Method: KedamaFloatArray>>primDivScalar:and:into: (in category 'primitives') -----
  primDivScalar: rcvr and: other into: result
  
+ 	<primitive: 'primitiveDivScalar' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveDivScalar."
- 	<primitive: 'primitiveDivScalar' module:'KedamaPlugin'>
- 	"^ KedamaPlugin doPrimitive: #primitiveDivScalar."
  
  	1 to: rcvr size do: [:i |
  		result at: i put: (rcvr at: i) / other.
  	].
  	^ result.
  !

Item was added:
+ ----- Method: KedamaFloatArray>>primEQArray:and:into: (in category '*Etoys-Squeakland-primitives') -----
+ primEQArray: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveEQArrays' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveEQArrays."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) = (other at: i) ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>primEQScalar:and:into: (in category '*Etoys-Squeakland-primitives') -----
+ primEQScalar: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveEQScalar' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveEQScalar."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) = other ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>primGEArray:and:into: (in category '*Etoys-Squeakland-primitives') -----
+ primGEArray: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveGEArrays' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveGEArrays."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) >= (other at: i) ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>primGEScalar:and:into: (in category '*Etoys-Squeakland-primitives') -----
+ primGEScalar: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveGEScalar' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveGEScalar."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) >= other ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>primGTArray:and:into: (in category '*Etoys-Squeakland-primitives') -----
+ primGTArray: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveGTArrays' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveGTArrays."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) > (other at: i) ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>primGTScalar:and:into: (in category '*Etoys-Squeakland-primitives') -----
+ primGTScalar: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveGTScalar' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveGTScalar."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) > other ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>primLEArray:and:into: (in category '*Etoys-Squeakland-primitives') -----
+ primLEArray: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveLEArrays' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveLEArrays."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) <= (other at: i) ifTrue: [1] ifFalse: [0])
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>primLEScalar:and:into: (in category '*Etoys-Squeakland-primitives') -----
+ primLEScalar: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveLEScalar' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveLEScalar."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) <= other ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>primLTArray:and:into: (in category '*Etoys-Squeakland-primitives') -----
+ primLTArray: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveLTArrays' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveLTArrays."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) < (other at: i) ifTrue: [1] ifFalse: [0])
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>primLTScalar:and:into: (in category '*Etoys-Squeakland-primitives') -----
+ primLTScalar: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveLTScalar' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveLTScalar."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) < other ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was changed:
  ----- Method: KedamaFloatArray>>primMulArray:and:into: (in category 'primitives') -----
  primMulArray: rcvr and: other into: result
  
+ 	<primitive: 'primitiveMulArrays' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveMulArrays."
- 	<primitive: 'primitiveMulArrays' module:'KedamaPlugin'>
- 	"^ KedamaPlugin doPrimitive: #primitiveMulArrays."
  
  	1 to: rcvr size do: [:i |
  		result at: i put: (rcvr at: i) * (other at: i)
  	].
  	^ result.
  !

Item was changed:
  ----- Method: KedamaFloatArray>>primMulScalar:and:into: (in category 'primitives') -----
  primMulScalar: rcvr and: other into: result
  
+ 	<primitive: 'primitiveMulScalar' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveMulScalar."
- 	<primitive: 'primitiveMulScalar' module:'KedamaPlugin'>
- 	"^ KedamaPlugin doPrimitive: #primitiveMulScalar."
  
  	1 to: rcvr size do: [:i |
  		result at: i put: (rcvr at: i) * other.
  	].
  	^ result.
  !

Item was added:
+ ----- Method: KedamaFloatArray>>primNEArray:and:into: (in category '*Etoys-Squeakland-primitives') -----
+ primNEArray: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveNEArrays' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveNEArrays."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) ~= (other at: i) ifTrue: [1] ifFalse: [0])
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>primNEScalar:and:into: (in category '*Etoys-Squeakland-primitives') -----
+ primNEScalar: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveNEScalar' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveNEScalar."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) ~= other ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>primRemArray:and:into: (in category '*Etoys-Squeakland-primitives') -----
+ primRemArray: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveRemArrays' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveRemArrays."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: (rcvr at: i) \\ (other at: i)
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: KedamaFloatArray>>primRemScalar:and:into: (in category '*Etoys-Squeakland-primitives') -----
+ primRemScalar: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveRemScalar' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveRemScalar."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: (rcvr at: i) \\ other.
+ 	].
+ 	^ result.
+ !

Item was changed:
  ----- Method: KedamaFloatArray>>primSubArray:and:into: (in category 'primitives') -----
  primSubArray: rcvr and: other into: result
  
+ 	<primitive: 'primitiveSubArrays' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveSubArrays."
- 	<primitive: 'primitiveSubArrays' module:'KedamaPlugin'>
- 	"^ KedamaPlugin doPrimitive: #primitiveSubArrays."
  
  	1 to: rcvr size do: [:i |
  		result at: i put: (rcvr at: i) - (other at: i)
  	].
  	^ result.
  !

Item was changed:
  ----- Method: KedamaFloatArray>>primSubScalar:and:into: (in category 'primitives') -----
  primSubScalar: rcvr and: other into: result
  
+ 	<primitive: 'primitiveSubScalar' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitiveSubScalar."
- 	<primitive: 'primitiveSubScalar' module:'KedamaPlugin'>
- 	"^ KedamaPlugin doPrimitive: #primitiveSubScalar."
  
  	1 to: rcvr size do: [:i |
  		result at: i put: (rcvr at: i) - other.
  	].
  	^ result.
  !

Item was added:
+ ----- Method: KedamaGetColorComponentTile>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') -----
+ parseNodeWith: encoder
+ 
+ 	^ patchTile parseNodeWith: encoder!

Item was added:
+ ----- Method: KedamaGetColorComponentTile>>sexpWith: (in category '*Etoys-Squeakland-code generation') -----
+ sexpWith: aDictionary
+ 
+ 	^ patchTile sexpWith: aDictionary.
+ !

Item was changed:
  ----- Method: KedamaMorph class>>defaultNameStemForInstances (in category 'class initialization') -----
  defaultNameStemForInstances
  
+ 	^ 'KedamaWorld' translatedNoop
- 	^ 'KedamaWorld' translated.
  !

Item was added:
+ ----- Method: KedamaMorph class>>migrateInstancesWithoutChangePending (in category '*Etoys-Squeakland-class initialization') -----
+ migrateInstancesWithoutChangePending
+ 
+ 	KedamaMorph allInstancesDo: [:each |
+ 		each migrateInstancesWithoutChangePending.
+ 	].
+ !

Item was changed:
  ----- Method: KedamaMorph class>>newSet (in category 'class initialization') -----
  newSet
  
  	| k p t s w |
+ 	Cursor wait showWhile: [
+ 		k _ self new.
+ 		k assuredPlayer.
+ 		p _ k defaultPatch.
+ 		t _ k assuredPlayer newTurtleForSet.
- 	k := self new.
- 	p := k assuredPlayer getPatch costume renderedMorph.
- 	t := k assuredPlayer newTurtleForSet.
  
+ 		s _ SelectionMorph new.
- 	s := SelectionMorph new.
  
+ 		w _ PasteUpMorph new.
+ 		w extent: 400 at 400.
+ 		p position: 275 at 50.
+ 		t position: 300 at 175.
+ 		k position: 25 at 25.
+ 		w addMorph: k.
+ 		w addMorph: t.
+ 		w addMorph: p.
+ 		w addMorph: s.
+ 		s bounds: w bounds.
+ 		s selectSubmorphsOf: w.
+ 	].
- 	w := PasteUpMorph new.
- 	w extent: 400 at 400.
- 	p position: 275 at 50.
- 	t position: 300 at 175.
- 	k position: 25 at 25.
- 	w addMorph: k.
- 	w addMorph: t.
- 	w addMorph: p.
- 	w addMorph: s.
- 	s bounds: w bounds.
- 	s selectSubmorphsOf: w.
  	^ s.
  !

Item was added:
+ ----- Method: KedamaMorph class>>supplementaryPartsDescriptions (in category 'class initialization') -----
+ supplementaryPartsDescriptions
+ 	^ {DescriptionForPartsBin
+ 		formalName: 'Particles' translatedNoop
+ 		categoryList: {'Basic' translatedNoop}
+ 		documentation: 'A Kedama World with pre-made components' translatedNoop
+ 		globalReceiverSymbol: #KedamaMorph
+ 		nativitySelector: #newSet.
+ 	}!

Item was changed:
  ----- Method: KedamaMorph>>allSubmorphNamesDo: (in category 'submorphs-accessing') -----
  allSubmorphNamesDo: aBlock
  
  	super allSubmorphNamesDo: aBlock.
+ 	aBlock value: self defaultPatch externalName.
- 	aBlock value: self player getPatch externalName.
  !

Item was changed:
  ----- Method: KedamaMorph>>cleanUp (in category 'setup') -----
  cleanUp
  
+ 	extension actorState: nil.
+ 	extension player: nil.
- 	self extension actorState: nil.
- 	self extension player: nil.
  	self initializeTurtlesDict.
  !

Item was added:
+ ----- Method: KedamaMorph>>convertToCurrentVersion:refStream: (in category 'private') -----
+ convertToCurrentVersion: varDict refStream: smartRefStrm
+ 	
+ 	self migrateInstancesWithoutChangePending.
+ !

Item was added:
+ ----- Method: KedamaMorph>>defaultPatch (in category '*Etoys-Squeakland-drawing') -----
+ defaultPatch
+ 
+ 	| p |
+ 	defaultPatch ifNotNil: [^ defaultPatch].
+ 	"For older projects, it trys to extract a reasonable answer from somewhere."
+ 	(self player respondsTo: #getPatch) ifTrue: [
+ 		defaultPatch _ self player getPatch costume renderedMorph.
+ 		^ defaultPatch.
+ 	].
+ 	p _ KedamaPatchMorph new.
+ 	p kedamaWorld: self.
+ 	p assuredPlayer.
+ 	defaultPatch _ p.
+ 	^ defaultPatch.
+ !

Item was changed:
  ----- Method: KedamaMorph>>delete (in category 'deleting') -----
  delete
  
+ 	| c |
  	super delete.
  	turtlesDict keysDo: [:k |
- 		| c |
  		self deleteAllTurtlesOfExampler: k.
+ 		c _ k costume.
- 		c := k costume.
  		c ifNotNil: [c renderedMorph delete].
  	].
  
+ 	defaultPatch ifNotNil: [defaultPatch delete].
  !

Item was changed:
  ----- Method: KedamaMorph>>drawOn: (in category 'drawing') -----
  drawOn: aCanvas
- 	"Display this StarSqueak world."
  
  	| result |
+ 	drawRequested ifFalse: [^ self].
+ 	drawRequested _ false.
+ 	changePending _ false.
  	"Time millisecondClockValue printString displayAt: 0 at 0."
  	self player ifNil: [^ aCanvas fillRectangle: (self bounds) color: self color].
  	patchVarDisplayForm fillColor: self color.
  	patchesToDisplay do: [:p |
  		p displayPatchVariableOn: patchVarDisplayForm.
  	].
  	self drawTurtlesOnForm: patchVarDisplayForm.
  	pixelsPerPatch = 1 ifTrue: [
  		aCanvas drawImage: patchVarDisplayForm at: bounds origin.
  	] ifFalse: [
+ 		result _ self zoom: patchVarDisplayForm into: magnifiedDisplayForm factor: pixelsPerPatch.
- 		result := self zoom: patchVarDisplayForm into: magnifiedDisplayForm factor: pixelsPerPatch.
  		result ifNil: [
  			aCanvas warpImage: patchVarDisplayForm transform: (MatrixTransform2x3 withScale: pixelsPerPatch) at: self innerBounds origin.
  		] ifNotNil: [
  			aCanvas drawImage: magnifiedDisplayForm at: bounds origin.
  		]
  	].
  
- 	autoChanged ifTrue: [self changed].
- 
  !

Item was added:
+ ----- Method: KedamaMorph>>drawRequest (in category 'accessing') -----
+ drawRequest
+ 
+ 	changePending ifFalse: [self changed].
+ 	changePending _ true.
+ !

Item was added:
+ ----- Method: KedamaMorph>>fullBounds (in category 'drawing') -----
+ fullBounds
+ 
+ 	drawRequested _ true.
+ 	^ super fullBounds.
+ !

Item was changed:
  ----- Method: KedamaMorph>>initialize (in category 'initialization') -----
  initialize
  
  	super initialize.
+ 	drawRequested _ true.
+ 	changePending _ false.
+ 	dimensions _ self class defaultDimensions.  "dimensions of this StarSqueak world in patches"
+ 	wrapX _ dimensions x asFloat.
+ 	wrapY _ dimensions y asFloat.
+ 	pixelsPerPatch _ 2.
- 	dimensions := self class defaultDimensions.  "dimensions of this StarSqueak world in patches"
- 	wrapX := dimensions x asFloat.
- 	wrapY := dimensions y asFloat.
- 	pixelsPerPatch := 2.
  	super extent: dimensions * pixelsPerPatch.
  	self assuredPlayer assureUniClass.
  	self clearAll.  "be sure this is done once in case setup fails to do it"
+ 	autoChanged _ true.
- 	autoChanged := true.
  	self leftEdgeMode: #wrap.
  	self rightEdgeMode: #wrap.
  	self topEdgeMode: #wrap.
  	self bottomEdgeMode: #wrap.
  
+ 	turtlesDictSemaphore _ Semaphore forMutualExclusion.
- 	turtlesDictSemaphore := Semaphore forMutualExclusion.
  !

Item was changed:
  ----- Method: KedamaMorph>>initializePatch (in category 'initialization') -----
  initializePatch
  
  	| f |
+ 	f _ self player addPatchVarNamed: #patch.
+ 	patchesToDisplay _ Array new: 0.
- 	f := self player addPatchVarNamed: #patch.
- 	patchesToDisplay := Array new: 0.
  	self addToPatchDisplayList: f.
+ 	defaultPatch _ f.
+ 	f kedamaWorld: self.
+ 	f formChanged.
  	^ f.
  !

Item was changed:
  ----- Method: KedamaMorph>>makePrototypeOfExampler:color: (in category 'turtles') -----
  makePrototypeOfExampler: examplerPlayer color: cPixel
  
+ 	| array inst info ind |
+ 	array _ examplerPlayer turtles.
+ 	info _ array info.
- 	| array inst info |
- 	array := examplerPlayer turtles.
- 	info := array info.
  	array size > 0 ifTrue: [
+ 		inst _ array makePrototypeFromFirstInstance.
- 		inst := array makePrototypeFromFirstInstance.
  		cPixel ifNotNil: [inst at: (info at: #color) put: cPixel].
  		^ inst.
  	].
  
+ 	inst _ Array new: array instSize.
- 	inst := Array new: array instSize.
  	info associationsDo: [:assoc |
+ 		ind _ assoc value.
+ 		(examplerPlayer turtles types at: ind) = #Boolean ifTrue: [
+ 			ind = 7
+ 				ifTrue: [inst at: ind put: 1]
+ 				ifFalse: [
+ 					inst at: ind put: ((examplerPlayer perform: (Utilities getterSelectorFor: assoc key)) ifTrue: [1] ifFalse: [0]).
+ 				]
+ 		] ifFalse: [
+ 			inst at: ind put: (examplerPlayer perform: (Utilities getterSelectorFor: assoc key)).
+ 		].
- 		inst at: (assoc value) put: (examplerPlayer perform: assoc key asGetterSelector).
  	].
  	cPixel ifNotNil: [inst at: (info at: #color) put: cPixel] ifNil: [inst at: (info at: #color) put: ((examplerPlayer getColor pixelValueForDepth: 32) bitAnd: 16rFFFFFF)].
- 	inst at: (info at: #visible) put: ((inst at: (info at: #visible)) ifTrue: [1] ifFalse: [0]).
  	^ inst.
  !

Item was added:
+ ----- Method: KedamaMorph>>migrateInstancesWithoutChangePending (in category '*Etoys-Squeakland-private') -----
+ migrateInstancesWithoutChangePending
+ 
+ 	self instVarNamed: 'changePending' put: false.
+ 	self instVarNamed: 'drawRequested' put: true.
+ 	self setKedamaWorldToKnownPatches.
+ !

Item was changed:
  ----- Method: KedamaMorph>>primSetRandomSeed: (in category 'private-primitives') -----
  primSetRandomSeed: seed
  
+ 	<primitive: 'kedamaSetRandomSeed' module: 'KedamaPlugin2'>
- 	<primitive: 'kedamaSetRandomSeed' module: 'KedamaPlugin'>
  	^ nil.
  !

Item was changed:
  ----- Method: KedamaMorph>>primZoom:into:srcWidth:height:multX:y: (in category 'private-primitives') -----
  primZoom: src into: dst srcWidth: sWidth height: sHeight multX: xFactor y: yFactor
  
+ 	<primitive: 'zoomBitmap' module: 'KedamaPlugin2'>
- 	<primitive: 'zoomBitmap' module: 'KedamaPlugin'>
  	"^ KedamaSqueakPlugin doPrimitive: #zoomBitmap."
  	^ nil.
  !

Item was changed:
  ----- Method: KedamaMorph>>random: (in category 'utils') -----
  random: range
  	"Answer a random integer between 0 and range."
  
  	| r val |
+ 	<primitive: 'randomRange' module: 'KedamaPlugin2'>
+ 	r _ range < 0 ifTrue: [range negated] ifFalse: [range].
+ 	RandomSeed _ ((RandomSeed * 1309) + 13849) bitAnd: 65535.
+ 	val _ (RandomSeed * (r + 1)) >> 16.
- 	<primitive: 'randomRange' module: 'KedamaPlugin'>
- 	r := range < 0 ifTrue: [range negated] ifFalse: [range].
- 	RandomSeed := ((RandomSeed * 1309) + 13849) bitAnd: 65535.
- 	val := (RandomSeed * (r + 1)) >> 16.
  	^ range < 0 ifTrue: [val negated] ifFalse: [^ val].
  
  !

Item was added:
+ ----- Method: KedamaMorph>>setKedamaWorldToKnownPatches (in category '*Etoys-Squeakland-utils') -----
+ setKedamaWorldToKnownPatches
+ 
+ 	patchesToDisplay do: [:e |
+ 		e kedamaWorld: self.
+ 		defaultPatch ifNotNil: [^ defaultPatch kedamaWorld: self].
+ 		"For older projects, it trys to extract a reasonable answer from somewhere."
+ 		(self player respondsTo: #getPatch) ifTrue: [
+ 			defaultPatch _ self player getPatch costume renderedMorph.
+ 			^ defaultPatch kedamaWorld: self.
+ 		].
+ 	].
+ !

Item was changed:
  ----- Method: KedamaMorph>>setScale (in category 'menu') -----
  setScale
  
  	| reply |
+ 	reply _ FillInTheBlank
+ 		request: 'Set the number of pixels per patch (a number between 1 and 10)?' translated
- 	reply := UIManager default
- 		request: 'Set the number of pixels per patch (a number between 1 and 10)?'
  		 initialAnswer: pixelsPerPatch printString.
  	reply isEmpty ifTrue: [^ self].
  	self pixelsPerPatch: reply asNumber.
  !

Item was added:
+ Object subclass: #KedamaParseTreeRewriter
+ 	instanceVariableNames: 'parseTree attributedTree notedRewrite patterns encoder'
+ 	classVariableNames: 'Debug'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tweak-Kedama-ParseTreeTransformer'!

Item was added:
+ ----- Method: KedamaParseTreeRewriter>>attributedTree: (in category 'accessing') -----
+ attributedTree: tree
+ 
+ 	attributedTree _ tree.
+ !

Item was added:
+ ----- Method: KedamaParseTreeRewriter>>createBlockNodeFromMessageNode: (in category 'private') -----
+ createBlockNodeFromMessageNode: aMessageNode
+ 
+ 	| newNode argNode statement |
+ 	argNode _ encoder encodeVariable: 'xxxObj'.
+ 	statement _ MessageNode new
+ 		receiver: argNode
+ 		selector: aMessageNode selector
+ 		arguments: aMessageNode arguments
+ 		precedence: aMessageNode selector precedence
+ 		from: encoder.
+ 	newNode _ BlockNode new
+ 		arguments: (Array with: argNode)
+ 		statements: (Array with: statement)
+ 		returns: false
+ 		from: encoder.
+ 
+ 	^ newNode!

Item was added:
+ ----- Method: KedamaParseTreeRewriter>>createMessageNode:inParentNode:receiverNode:selector:arguments: (in category 'private') -----
+ createMessageNode: aMessageNode inParentNode: parentNode receiverNode: receiverNameOrNode selector: selectorSymbolOrNode arguments: argumentsArray
+ 
+ 	| recv sel n |
+ 	recv _ receiverNameOrNode isString ifTrue: [
+ 		TempVariableNode new name: receiverNameOrNode index: 0 type: 2.
+ 		"encoder encodeVariable: receiverNameOrNode."
+ 	] ifFalse: [
+ 		receiverNameOrNode.
+ 	].
+ 
+ 	sel _ selectorSymbolOrNode isString ifTrue: [
+ 		selectorSymbolOrNode asSymbol
+ 	] ifFalse: [
+ 		selectorSymbolOrNode key.
+ 	].
+ 
+ 	n _ MessageNode new
+ 		receiver: recv
+ 		selector: sel
+ 		arguments: argumentsArray
+ 		precedence: sel precedence
+ 		from: encoder.
+ 
+ 	^ n!

Item was added:
+ ----- Method: KedamaParseTreeRewriter>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	super initialize.
+ 	notedRewrite _ IdentityDictionary new.
+ !

Item was added:
+ ----- Method: KedamaParseTreeRewriter>>makeBlockNodeArguments:statements:returns: (in category 'private') -----
+ makeBlockNodeArguments: args statements: statementsArray returns: returnBool
+ 
+ 	| realArgs |
+ 	realArgs _ args collect: [:arg |
+ 		arg isString
+ 			ifTrue: [TempVariableNode new name: arg index: 1 type: 2; yourself
+ 					"encoder autoBind: arg"]
+ 			ifFalse: [arg]
+ 	].
+ 	
+ 	^ BlockNode new
+ 		arguments: realArgs
+ 		statements: statementsArray
+ 		returns: returnBool
+ 		from: encoder.
+ !

Item was added:
+ ----- Method: KedamaParseTreeRewriter>>noteRewriteMessageNode:inParentNode:withReceiver:selector:arguments: (in category 'private') -----
+ noteRewriteMessageNode: aMessageNode inParentNode: parentNode withReceiver: receiver selector: selector arguments: arguments
+ 
+ 	notedRewrite
+ 		at: aMessageNode
+ 		put: {aMessageNode. parentNode. receiver. selector. arguments}.
+ !

Item was added:
+ ----- Method: KedamaParseTreeRewriter>>parseTree (in category 'accessing') -----
+ parseTree
+ 
+ 	^ parseTree.
+ !

Item was added:
+ ----- Method: KedamaParseTreeRewriter>>parseTree: (in category 'accessing') -----
+ parseTree: tree
+ 
+ 	parseTree _ tree.
+ !

Item was added:
+ ----- Method: KedamaParseTreeRewriter>>rewriteBlockNode:inParentNode:arguments:statements:returns: (in category 'private') -----
+ rewriteBlockNode: aBlockNode inParentNode: parentNode arguments: argNodes statements: statementsArray returns: returnBool
+ 
+ 	| newNode |
+ 	newNode _ BlockNode new
+ 		arguments: argNodes
+ 		statements: statementsArray
+ 		returns: returnBool
+ 		from: encoder.
+ 
+ 	parentNode replaceNode: aBlockNode with: newNode.
+ !

Item was added:
+ ----- Method: KedamaParseTreeRewriter>>rewriteMessageNode:inParentNode:receiverNode:selector:arguments: (in category 'private') -----
+ rewriteMessageNode: aMessageNode inParentNode: parentNode receiverNode: receiverNameOrNode selector: selectorSymbolOrNode arguments: argumentsArray
+ 
+ 	| newNode |
+ 	newNode _ self createMessageNode: aMessageNode inParentNode: parentNode receiverNode: receiverNameOrNode selector: selectorSymbolOrNode arguments: argumentsArray.
+ 
+ 	parentNode replaceNode: aMessageNode with: newNode.
+ !

Item was added:
+ ----- Method: KedamaParseTreeRewriter>>setEncoderFor:in: (in category 'accessing') -----
+ setEncoderFor: playerScripted in: aWorld
+ 
+ 	encoder _ ScriptEncoder new init: playerScripted class context: nil notifying: nil; referenceObject: aWorld.
+ !

Item was added:
+ ----- Method: KedamaParseTreeRewriter>>visit:andParent: (in category 'entry point') -----
+ visit: node andParent: parent
+ 
+ 	self subclassResponsibility!

Item was changed:
  Morph subclass: #KedamaPatchMorph
+ 	instanceVariableNames: 'form displayMax shiftAmount useLogDisplay displayForm diffusionRate scaledEvaporationRate sniffRange formChanged tmpForm autoChanged displayType changePending'
- 	instanceVariableNames: 'form displayMax shiftAmount useLogDisplay displayForm diffusionRate scaledEvaporationRate sniffRange formChanged tmpForm autoChanged displayType'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Etoys-StarSqueak'!
  
  !KedamaPatchMorph commentStamp: 'yo 6/18/2004 18:31' prior: 0!
  I represent the patch variable.
  !

Item was changed:
  ----- Method: KedamaPatchMorph class>>additionsToViewerCategories (in category 'scripting') -----
  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."
  
  	^ #(
  
  	(kedama (
+ 		(slot evaporationRate 'The rate for the decay function.' Number readWrite Patch getEvaporationRate Patch setEvaporationRate:)
+ 		(slot diffusionRate 'The rate for the diffusion function.' Number readWrite Patch getDiffusionRate Patch setDiffusionRate:)
+ 		(slot sniffRange 'The distance to sample the values for calculating highest gradient.' Number readWrite Patch getSniffRange Patch setSniffRange:)
- 		(slot evaporationRate 'evaporation rate' Number readWrite Patch getEvaporationRate Patch setEvaporationRate:)
- 		(slot diffusionRate 'diffusion rate' Number readWrite Patch getDiffusionRate Patch setDiffusionRate:)
- 		(slot sniffRange 'sniff range' Number readWrite Patch getSniffRange Patch setSniffRange:)
  		(slot shiftAmount 'shift amount when log-based color conversion is not used' Number readWrite Player getDisplayShiftAmount Player setDisplayShiftAmount:)
  		(slot scaleMax 'scale when log-based color conversion is used' Number readWrite Player getDisplayScaleMax Player setDisplayScaleMax:)
  		"(slot useLogDisplay 'log-based color conversion' Boolean readWrite Player getUseLogDisplay Player setUseLogDisplay:)"
  		(slot displayType 'how to map the value in cells to color' PatchDisplayMode readWrite Player getDisplayType Player setDisplayType:)
  		(slot color 'The color of the object' Color readWrite Player getColor  Player  setColor:)
  
  		"(slot autoUpdate 'Updating screen always' Boolean readWrite Player getAutoUpdate  Player setAutoUpdate:)"
  		(command clear 'clear all patch')
  		(command diffusePatchVariable 'diffuse')
  		(command decayPatchVariable 'decay')
  
  		(command redComponentInto: 'split red component into another patch' Patch)
  		(command greenComponentInto: 'split green component into another patch' Patch)
  		(command blueComponentInto: 'split blue component into another patch' Patch)
  
  		(command redComponentFrom: 'merge red component from another patch' Patch)
  		(command greenComponentFrom: 'merge green component from another patch' Patch)
  		(command blueComponentFrom: 'merge blue component from another patch' Patch)
  
  )))
  !

Item was changed:
  ----- Method: KedamaPatchMorph class>>defaultNameStemForInstances (in category 'scripting') -----
  defaultNameStemForInstances
  
+ 	^ 'patch' translatedNoop
- 	^ 'patch' translated.
  !

Item was added:
+ ----- Method: KedamaPatchMorph class>>migrateInstancesWithoutChangePending (in category '*Etoys-Squeakland-class initialization') -----
+ migrateInstancesWithoutChangePending
+ 
+ 	KedamaPatchMorph allInstancesDo: [:each |
+ 		each migrateInstancesWithoutChangePending.
+ 	].
+ !

Item was changed:
  ----- Method: KedamaPatchMorph>>convertToCurrentVersion:refStream: (in category 'private') -----
  convertToCurrentVersion: varDict refStream: smartRefStrm
  	
  	varDict at: 'useLogDisplay' ifPresent: [ :x | 
+ 		displayType _ x = true ifTrue: [#logScale] ifFalse: [#linear].
- 		displayType := x ifTrue: [#logScale] ifFalse: [#linear].
  	].
+ 	displayType ifNil: [displayType _ #logScale].
+ 	self migrateInstancesWithoutChangePending.
- 	displayType ifNil: [displayType := #logScale].
  	^super convertToCurrentVersion: varDict refStream: smartRefStrm.
  !

Item was changed:
  ----- Method: KedamaPatchMorph>>displayPatchVariableOn: (in category 'drawing') -----
  displayPatchVariableOn: aForm
  
  	| patchVar pixelValue |
  	form ifNil: [^self].
  
  	formChanged ifTrue: [
  		"displayForm fillColor: Color transparent."
+ 		pixelValue _ (self color pixelValueForDepth: 32) bitAnd: 16rFFFFFF.
- 		pixelValue := (self color pixelValueForDepth: 32) bitAnd: 16rFFFFFF.
  		form bits class == ByteArray ifTrue: [form unhibernate].
+ 		patchVar _ form bits.
- 		patchVar := form bits.
  		displayForm bits class == ByteArray ifTrue: [displayForm unhibernate].
  		displayType = #linear ifTrue: [
  			self primMakeMaskOf: patchVar in: displayForm bits colorPixel: pixelValue shift: shiftAmount.
  		].
  		displayType = #logScale ifTrue: [
  			self primMakeMaskOf: patchVar in: displayForm bits colorPixel: pixelValue max: displayMax.
  		].
  		displayType = #color ifTrue: [
  			form displayOn: displayForm.
  			displayForm fixAlpha.
  		].
  	].
  
  	tmpForm fillColor: Color black.
  	displayForm displayOn: tmpForm at: 0 at 0 rule: 24.
  	aForm == tmpForm ifFalse: [
  		displayForm displayOn: aForm at: 0 at 0 rule: 24.
  	].
+ 	formChanged _ false.
- 	formChanged := false.
  
  !

Item was changed:
  ----- Method: KedamaPatchMorph>>drawOn: (in category 'drawing') -----
  drawOn: aCanvas
  
  	formChanged ifTrue: [
  		self displayPatchVariableOn: tmpForm.
  	].
  	aCanvas drawImage: tmpForm at: self innerBounds origin.
- 
- 	autoChanged ifTrue: [self changed].
  !

Item was added:
+ ----- Method: KedamaPatchMorph>>drawRequest (in category '*Etoys-Squeakland-drawing') -----
+ drawRequest
+ 
+ 	changePending ifFalse: [self changed].
+ 	changePending _ true.
+ !

Item was changed:
  ----- Method: KedamaPatchMorph>>formChanged (in category 'drawing') -----
  formChanged
  
+ 	formChanged _ true.
+ 	kedamaWorld drawRequest.
+ 	self drawRequest.
- 	formChanged := true.
  !

Item was added:
+ ----- Method: KedamaPatchMorph>>fullBounds (in category 'drawing') -----
+ fullBounds
+ 
+ 	formChanged _ true.
+ 	^ super fullBounds.
+ !

Item was changed:
  ----- Method: KedamaPatchMorph>>initialize (in category 'initialization') -----
  initialize
  
  	super initialize.
  
+ 	changePending := false.
+ 	formChanged := true.
  	self evaporationRate: 6.
  	self diffusionRate: 1.
  	self sniffRange: 1.
  
  	displayType := #logScale.
  	displayMax := WordArray with: 1024.
  	shiftAmount := -2.
- 
- 	autoChanged := true.
- 
- 	self formChanged.
  !

Item was changed:
  ----- Method: KedamaPatchMorph>>initializeForm: (in category 'initialization') -----
  initializeForm: aForm 
  
+ 	changePending _ false.
+ 	form _ aForm. 
- 	form := aForm. 
  	form fillColor: Color transparent.
  
+ 	displayForm _ (Form extent: aForm extent depth: 32).
+ 	tmpForm _ (Form extent: aForm extent depth: 32).
- 	displayForm := (Form extent: aForm extent depth: 32).
- 	tmpForm := (Form extent: aForm extent depth: 32).
  	tmpForm fillColor: Color black.
  
  	super extent: form extent.
  	self changed.
- 	self formChanged.
  !

Item was added:
+ ----- Method: KedamaPatchMorph>>kedamaWorld: (in category '*Etoys-Squeakland-initialization') -----
+ kedamaWorld: anObject
+ 
+ 	kedamaWorld _ anObject.
+ !

Item was added:
+ ----- Method: KedamaPatchMorph>>migrateInstancesWithoutChangePending (in category '*Etoys-Squeakland-private') -----
+ migrateInstancesWithoutChangePending
+ 
+ 	self instVarNamed: 'changePending' put: false.
+ !

Item was changed:
  ----- Method: KedamaPatchMorph>>pixelAtX:y:put: (in category 'commands and slots') -----
  pixelAtX: xPos y: yPos put: value
  
  	| x y i v |
+ 	x _ xPos truncated.
+ 	y _ yPos truncated.
+ 	v _ (value asInteger max: 0).
- 	x := xPos truncated.
- 	y := yPos truncated.
- 	v := (value asInteger max: 0) bitAnd: 16rFFFFFFFF.
  	((x < 0) or: [y < 0]) ifTrue: [^ self].
  	((x >= form width) or: [y >= form height]) ifTrue: [^ self].
+ 	i _ ((y * form width) + x) + 1.
- 	i := ((y * form width) + x) + 1.
  	form bits class == ByteArray ifTrue: [form unhibernate].
  	form bits at: i put: v.
  	self formChanged.
  !

Item was changed:
  ----- Method: KedamaPatchMorph>>primMakeMaskOf:in:colorPixel:max: (in category 'primitives') -----
  primMakeMaskOf: dataBits in: maskBits colorPixel: pixel max: max
  
  	| highMask alpha maxLog data |
+ 	<primitive: 'makeMaskLog' module: 'KedamaPlugin2'>
- 	<primitive: 'makeMaskLog' module: 'KedamaPlugin'>
  	"^ KedamaSqueakPlugin doPrimitive: #makeMaskLog."
  
  
+ 	highMask _ 16rFF000000.
+ 	"maxLog _ self cCode: 'log(max)' inSmalltalk: [max first ln]."
+ 	maxLog _ max first ln.
+ 	maxLog _ 255.0 / maxLog.
- 	highMask := 16rFF000000.
- 	"maxLog := self cCode: 'log(max)' inSmalltalk: [max first ln]."
- 	maxLog := max first ln.
- 	maxLog := 255.0 / maxLog.
  
  	1 to: dataBits size do: [:i |
+ 		data _ dataBits at: i.
+ 		data = 0 ifTrue: [alpha _ 0] ifFalse: [
+ 			"alpha _ ((255.0 / maxLog) * (self cCode: 'log(data)' inSmalltalk: [data ln])) asInteger."
+ 			alpha _ (maxLog * (data ln)) asInteger.
- 		data := dataBits at: i.
- 		data = 0 ifTrue: [alpha := 0] ifFalse: [
- 			"alpha := ((255.0 / maxLog) * (self cCode: 'log(data)' inSmalltalk: [data ln])) asInteger."
- 			alpha := (maxLog * (data ln)) asInteger.
  
  		].
+ 		(alpha > 255) ifTrue: [alpha _ 255].
- 		(alpha > 255) ifTrue: [alpha := 255].
  		maskBits at: i put: (((alpha << 24) bitAnd: highMask) bitOr: pixel).
  	].
  	^ self.
  !

Item was changed:
  ----- Method: KedamaPatchMorph>>primMakeMaskOf:in:colorPixel:shift: (in category 'primitives') -----
  primMakeMaskOf: dataBits in: maskBits colorPixel: pixel shift: shift
  
  	| highMask data alpha |
+ 	<primitive: 'makeMask' module: 'KedamaPlugin2'>
- 	<primitive: 'makeMask' module: 'KedamaPlugin'>
  	"^ KedamaSqueakPlugin doPrimitive: #makeMask."
  
+ 	highMask _ 16rFF000000.
- 	highMask := 16rFF000000.
  	1 to: dataBits size do: [:i |
+ 		data _ dataBits at: i.
+ 		alpha _ data bitShift: shift.
+ 		(alpha > 255) ifTrue: [alpha _ 255].
- 		data := dataBits at: i.
- 		alpha := data bitShift: shift.
- 		(alpha > 255) ifTrue: [alpha := 255].
  		maskBits at: i put: (((alpha << 24) bitAnd: highMask) bitOr: pixel).
  	].
  
  	^ self.
  !

Item was changed:
  ----- Method: KedamaPatchMorph>>primPixelsAtXArray:yArray:bits:width:height:into: (in category 'primitives') -----
  primPixelsAtXArray: xArray yArray: yArray bits: bits width: width height: height into: aWordArray
  	| x y formIndex val |
+ 	<primitive: 'primPixelsAtXY' module: 'KedamaPlugin2'>
- 	<primitive: 'primPixelsAtXY' module: 'KedamaPlugin'>
  	"^ KedamaPlugin doPrimitive: #primPixelsAtXY."
  	1 to: aWordArray size do: [:i |
+ 		val _ nil.
+ 		x _ (xArray at: i) truncated.
+ 		y _ (yArray at: i) truncated.
+ 		((x < 0) or: [y < 0]) ifTrue: [val _ 0].
+ 		((x >= form width) or: [y >= form height]) ifTrue: [val _ 0].
- 		val := nil.
- 		x := (xArray at: i) truncated.
- 		y := (yArray at: i) truncated.
- 		((x < 0) or: [y < 0]) ifTrue: [val := 0].
- 		((x >= form width) or: [y >= form height]) ifTrue: [val := 0].
  		val ifNil: [
+ 			formIndex _ ((y * form width) + x) + 1.
+ 			val _ bits at: formIndex.
- 			formIndex := ((y * form width) + x) + 1.
- 			val := bits at: formIndex.
  		].
  		aWordArray at: i put: val.
  	].
  !

Item was added:
+ ----- Method: KedamaPatchMorph>>primSetPixelsPredicates:xArray:yArray:bits:width:height:value: (in category '*Etoys-Squeakland-primitives') -----
+ primSetPixelsPredicates: predicates xArray: xArray yArray: yArray bits: bits width: width height: height value: value
+ 
+ 	| v |
+ 	<primitive: 'primSetPixelsAtXY' module: 'KedamaPlugin2'>
+ "	^ KedamaPlugin2 doPrimitive: #primSetPixelsAtXY."
+ 
+ 	value isNumber ifTrue: [v _ value].
+ 	1 to: xArray size do: [:i |
+ 		(predicates at: i) = 1 ifTrue: [
+ 			value isNumber ifFalse: [
+ 				v _ value at: i.
+ 			].		
+ 			self pixelAtX: (xArray at: i) y: (yArray at: i) put: v.
+ 		].
+ 	].
+ !

Item was changed:
  ----- Method: KedamaPatchMorph>>primUpHillX:y:heading:bits:width:height:sniffRange: (in category 'primitives') -----
  primUpHillX: tX y: tY heading: tH bits: bits width: width height: height sniffRange: s
  
+ 	<primitive: 'primUpHill' module: 'KedamaPlugin2'>
- 	<primitive: 'primUpHill' module: 'KedamaPlugin'>
  	"^ KedamaPlugin doPrimitive: #primUpHill."
  	^ nil
  !

Item was added:
+ ----- Method: KedamaPatchMorph>>setPixelsPredicates:xArray:yArray:value: (in category '*Etoys-Squeakland-commands and slots') -----
+ setPixelsPredicates: predicates xArray: xArray yArray: yArray value: value
+ 
+ 	form bits class == ByteArray ifTrue: [form unhibernate].
+ 	self primSetPixelsPredicates: predicates xArray: xArray yArray: yArray bits: form bits width: form width height: form height value: value.
+ 	self formChanged.
+ !

Item was changed:
  ----- Method: KedamaPatchTile>>initialize (in category 'initialization') -----
  initialize
  
  	super initialize.
+ 	type _ #objRef.
- 	type := #literal.
  	self extent: 16 at 16.
  !

Item was added:
+ ----- Method: KedamaPatchTile>>useDefaultPatch: (in category '*Etoys-Squeakland-initialization support') -----
+ useDefaultPatch: aPatch
+ 
+ 	| aTile displayer |
+ 	self removeAllMorphs.
+ 	"literal _ aPatch."
+ 	type _ #objRef.
+ 	aTile _ KedamaPatchType basicNew newReadoutTile.
+ 	displayer _ UpdatingStringMorph new
+ 		getSelector: #yourself;
+ 		target: 'patch';
+ 		growable: true;
+ 		minimumWidth: 24;
+ 		putSelector: nil;
+ 		font: Preferences standardEToysFont.
+ 	displayer stepTime: 1000.
+ 	"Note that when typeSymbol = #number, the #target: call above will have dealt with floatPrecision details"
+ 
+ 	displayer useStringFormat.
+ 	aTile addMorphBack: displayer.
+ 	aTile setLiteralInitially: ('patch').
+ 	self addMorphBack: aTile.
+ !

Item was changed:
  ----- Method: KedamaPatchTile>>usePatch: (in category 'initialization support') -----
  usePatch: aPatch
  
+ 	self setToReferTo: aPatch.
- 	| aTile displayer |
- 	self removeAllMorphs.
- 	literal := aPatch.
- 
- 
- 	aTile := KedamaPatchType basicNew newReadoutTile.
- 
- 	displayer := UpdatingStringMorph new
- 		getSelector: #externalName;
- 		target: aPatch;
- 		growable: true;
- 		minimumWidth: 24;
- 		putSelector: nil.
- 	displayer stepTime: 1000.
- 	"Note that when typeSymbol = #number, the #target: call above will have dealt with floatPrecision details"
- 
- 	displayer useStringFormat.
- 	aTile addMorphBack: displayer.
- 	aTile setLiteralInitially: (aPatch perform: #externalName).
- 	self addMorphBack: aTile.
  !

Item was changed:
  ----- Method: KedamaPatchType>>defaultArgumentTileFor: (in category 'tile protocol') -----
  defaultArgumentTileFor: aPlayer
  	"Answer a tile to represent the type"
  	| patch morph |
+ 	patch _ KedamaPatchTile new typeColor: self typeColor.
+ 	morph _ aPlayer costume renderedMorph.
+ 	(morph isKindOf: KedamaTurtleMorph) ifTrue: [
+ 		patch useDefaultPatch: aPlayer kedamaWorld defaultPatch player.
+ 	].
- 	patch := KedamaPatchTile new typeColor: self typeColor.
- 	morph := aPlayer costume renderedMorph.
  	(morph isKindOf: KedamaMorph) ifTrue: [
+ 		patch useDefaultPatch: morph defaultPatch player.
- 		patch usePatch: aPlayer costume renderedMorph player getPatch.
  	].
  	(morph isKindOf: KedamaPatchMorph) ifTrue: [
+ 		patch useDefaultPatch: morph player.
- 		patch usePatch: morph player.
  	].
  	^ patch.
  !

Item was changed:
  ----- Method: KedamaPatchType>>initialValueForASlotFor: (in category 'tile protocol') -----
  initialValueForASlotFor: aPlayer
  	"Answer the value to give initially to a newly created slot of the given type in the given player"
  
+ 	^ aPlayer kedamaWorld defaultPatch!
- 	^ aPlayer costume renderedMorph player getPatch.
- !

Item was changed:
  ----- Method: KedamaPatchType>>updatingTileForTarget:partName:getter:setter: (in category 'tile protocol') -----
  updatingTileForTarget: aTarget partName: partName getter: getter setter: setter
  
  	| aTile displayer actualSetter |
+ 	actualSetter _ setter ifNotNil:
- 	actualSetter := setter ifNotNil:
  		[(#(none nil unused) includes: setter) ifTrue: [nil] ifFalse: [setter]].
  
+ 	aTile _ self newReadoutTile.
- 	aTile := self newReadoutTile.
  
+ 	displayer _ UpdatingStringMorph new
- 	displayer := UpdatingStringMorph new
  		getSelector: #externalName;
+ 		target: aTarget costume renderedMorph;
- 		target: (aTarget perform: getter) costume renderedMorph;
  		growable: true;
  		minimumWidth: 24;
  		putSelector: nil.
  	displayer stepTime: 1000.
  	"Note that when typeSymbol = #number, the #target: call above will have dealt with floatPrecision details"
  
  	self setFormatForDisplayer: displayer.
  	aTile addMorphBack: displayer.
  	(actualSetter notNil and: [self wantsArrowsOnTiles]) ifTrue: [aTile addArrows].	
+ 	getter numArgs == 0 ifTrue:
- 	getter numArgs = 0 ifTrue:
  		[aTile setLiteralInitially: (aTarget perform: getter)].
  	displayer useStringFormat.
  
  	^ aTile
  !

Item was added:
+ ProtoObject subclass: #KedamaPlugin2
+ 	instanceVariableNames: 'kedamaRandomSeed randA randM randQ randR'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-EToys-Kedama'!

Item was added:
+ ----- Method: KedamaPlugin2 class>>declareCVarsIn: (in category 'as yet unclassified') -----
+ declareCVarsIn: cg
+ 
+ 	cg var: #kedamaRandomSeed type: 'unsigned int'.
+ 	cg var: #randA type: 'unsigned int'.
+ 	cg var: #randM type: 'unsigned int'.
+ 	cg var: #randQ type: 'unsigned int'.
+ 	cg var: #randR type: 'unsigned int'.
+ !

Item was added:
+ ----- Method: KedamaPlugin2 class>>isUniClass (in category 'accessing method dictionary') -----
+ isUniClass
+ 
+ 	^ self ~~ KedamaPlugin2!

Item was added:
+ ----- Method: KedamaPlugin2>>degreesFromX:y: (in category 'primitives') -----
+ degreesFromX: x y: y
+ 
+ 	| tanVal theta |
+ 	self inline: true.
+ 	self returnTypeC: 'double'.
+ 	self var: 'x' declareC: 'double x'.
+ 	self var: 'y' declareC: 'double y'.
+ 	self var: 'tanVal' declareC: 'double tanVal'.
+ 	self var: 'theta' declareC: 'double theta'.
+ 
+ 	x = 0.0 ifTrue: [
+ 		y >= 0.0 ifTrue: [^ 90.0] ifFalse: [^ 270.0].
+ 	] ifFalse: [
+ 		tanVal _ y / x.
+ 		theta _ self cCode: 'atan(tanVal)' inSmalltalk: [tanVal arcTan].
+ 		x >= 0.0 ifTrue: [
+ 			y >= 0.0
+ 				ifTrue: [^ theta / 0.0174532925199433]
+ 				ifFalse: [^ 360.0 + (theta / 0.0174532925199433)]
+ 		] ifFalse: [
+ 			^ 180.0 + (theta / 0.0174532925199433)
+ 		]
+ 	].
+ 	^ 0.0.
+ 
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>degreesToRadians: (in category 'primitives') -----
+ degreesToRadians: degrees
+ 
+ 	| headingRadians deg q |
+ 	self inline: true.
+ 	self returnTypeC: 'double'.
+ 	self var: 'degrees' declareC: 'double degrees'.
+ 	self var: 'deg' declareC: 'double deg'.
+ 	self var: 'headingRadians' declareC: 'double headingRadians'.
+ 	self var: 'q' declareC: 'int q'.
+ 
+ 	deg _ 90.0 - degrees.
+ 	q _ deg / 360.0.
+ 	deg < 0.0 ifTrue: [q _ q - 1].
+ 	headingRadians _ (deg - (q * 360.0)) * 0.0174532925199433.
+ 	^ headingRadians.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>drawTurtlesInArray (in category 'primitives') -----
+ drawTurtlesInArray
+ 
+ 	| visibleArray colorArray yArray xArray destHeight destWidth destBits size x y visible visibleOop colorOop yOop xOop destOop bitsIndex |
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'destBits' declareC: 'unsigned int *destBits'.
+ 	self var: 'xArray' declareC: 'float *xArray'.
+ 	self var: 'yArray' declareC: 'float *yArray'.
+ 	self var: 'colorArray' declareC: 'unsigned int *colorArray'.
+ 	self var: 'visibleArray' declareC: 'unsigned char *visibleArray'.
+ 
+ 	visibleOop _ interpreterProxy stackValue: 0.
+ 	colorOop _ interpreterProxy stackValue: 1.
+ 	yOop _ interpreterProxy stackValue: 2.
+ 	xOop _ interpreterProxy stackValue: 3.
+ 	destHeight _ interpreterProxy stackIntegerValue: 4.
+ 	destWidth _ interpreterProxy stackIntegerValue: 5.
+ 	destOop _ interpreterProxy stackValue: 6.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 
+ 	(interpreterProxy isWords: destOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: xOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: yOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: colorOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isBytes: visibleOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	(destHeight * destWidth) ~= (interpreterProxy slotSizeOf: destOop) ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	size _ interpreterProxy slotSizeOf: xOop.
+ 	(interpreterProxy slotSizeOf: yOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy slotSizeOf: colorOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy slotSizeOf: visibleOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	xArray _ interpreterProxy firstIndexableField: xOop.
+ 	yArray _ interpreterProxy firstIndexableField: yOop.
+ 	colorArray _ interpreterProxy firstIndexableField: colorOop.
+ 	visibleArray _ interpreterProxy firstIndexableField: visibleOop.
+ 	destBits _ interpreterProxy firstIndexableField: destOop.
+ 
+ 	0 to: size - 1 do: [:i |
+ 		x _ self cCoerce: (xArray at: i) to: 'int'.
+ 		self cCode: '' inSmalltalk: [x _ x asInteger].
+ 		y _ self cCoerce: (yArray at: i) to: 'int'.
+ 		self cCode: '' inSmalltalk: [y _ y asInteger].
+ 		visible _ (visibleArray at: i).
+ 		((visible ~= 0) and: [((x >= 0) and: [y >= 0]) and: [(x < destWidth) and: [y < destHeight]]]) ifTrue: [
+ 			bitsIndex _ ((y * destWidth) + x).
+ 			destBits at: bitsIndex put: (colorArray at: i).
+ 		]
+ 	].
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 7.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>getHeadingArrayInto (in category 'primitives') -----
+ getHeadingArrayInto
+ 
+ 	| resultOop headingOop size headingArray resultArray heading |
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'headingArray' declareC: 'float *headingArray'.
+ 	self var: 'resultArray' declareC: 'float *resultArray'.
+ 	self var: 'heading' declareC: 'double heading'.
+ 
+ 	resultOop _ interpreterProxy stackValue: 0.
+ 	headingOop _ interpreterProxy stackValue: 1.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isWords: headingOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: resultOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	size _ interpreterProxy slotSizeOf: headingOop.
+ 	(interpreterProxy slotSizeOf: resultOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	headingArray _ interpreterProxy firstIndexableField: headingOop.
+ 	resultArray _ interpreterProxy firstIndexableField: resultOop.
+ 
+ 	0 to: size - 1 do: [:i |
+ 		heading _ headingArray at: i.
+ 		heading _ heading / 0.0174532925199433.
+ 		heading _ 90.0 - heading.
+ 		heading > 0.0 ifFalse: [heading _ heading + 360.0].
+ 		resultArray at: i put: heading.
+ 	].
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 2.
+ 
+ 	!

Item was added:
+ ----- Method: KedamaPlugin2>>getScalarHeading (in category 'primitives') -----
+ getScalarHeading
+ 
+ 	| headingOop headingArray heading index |
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'headingArray' declareC: 'float *headingArray'.
+ 	self var: 'heading' declareC: 'double heading'.
+ 
+ 	headingOop _ interpreterProxy stackValue: 0.
+ 	index _ interpreterProxy stackIntegerValue: 1.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isWords: headingOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	(interpreterProxy slotSizeOf: headingOop) < index ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	headingArray _ interpreterProxy firstIndexableField: headingOop.
+ 
+ 	heading _ headingArray at: index - 1.
+ 	heading _ self radiansToDegrees: heading.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	interpreterProxy pop: 3.
+ 	interpreterProxy pushFloat: heading.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>initialiseModule (in category 'primitives') -----
+ initialiseModule
+ 
+ 	self export: true.
+ 	kedamaRandomSeed _ 17.
+ 
+ 	randA := 16r000041A7.    " magic constant =      16807 "
+ 	randM := 16r7FFFFFFF.    " magic constant = 2147483647 "
+ 	randQ := randM // randA.
+ 	randR  := randM \\ randA.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>kedamaRandom2: (in category 'primitives') -----
+ kedamaRandom2: range
+ 
+ 	| lo hi r v val |
+ 	self inline: true.
+ 	range < 0 ifTrue: [r _ 0 - range] ifFalse: [r _ range].
+ 	hi _ kedamaRandomSeed // randQ.
+ 	lo _ kedamaRandomSeed \\ randQ. 
+ 	kedamaRandomSeed _ (randA * lo) - (randR * hi).
+ 	v _ kedamaRandomSeed bitAnd: 65535.
+ 	val _ (v * (r + 1)) >> 16.
+ 	range < 0 ifTrue: [^ 0 - val] ifFalse: [^ val].
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>kedamaRandom: (in category 'primitives') -----
+ kedamaRandom: range
+ 
+ 	| r val |
+ 	self inline: true.
+ 	range < 0 ifTrue: [r _ 0 - range] ifFalse: [r _ range].
+ 	kedamaRandomSeed _ ((kedamaRandomSeed * 1309) + 13849) bitAnd: 65535.
+ 	val _ (kedamaRandomSeed * (r + 1)) >> 16.
+ 	range < 0 ifTrue: [^ 0 - val] ifFalse: [^ val].
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>kedamaSetRandomSeed (in category 'primitives') -----
+ kedamaSetRandomSeed
+ 
+ 	| seed |
+ 	self inline: true.
+ 	self export: true.
+ 	seed _ interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	kedamaRandomSeed _ seed bitAnd: 65536.
+ 
+ 	interpreterProxy pop: 1.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>makeMask (in category 'primitives') -----
+ makeMask
+ 
+ 	| shiftAmount pixel maskBits dataBits dataSize maskSize dOrigin mOrigin data alpha highMask |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'dOrigin' declareC: 'unsigned int* dOrigin'.
+ 	self var: 'mOrigin' declareC: 'unsigned int* mOrigin'.
+ 	self var: 'highMask' declareC: 'unsigned int highMask'.
+ 	self var: 'alpha' declareC: 'unsigned int alpha'.
+ 	self var: 'pixel' declareC: 'unsigned int pixel'.
+ 
+ 	shiftAmount _ interpreterProxy stackIntegerValue: 0.
+ 	pixel _ interpreterProxy stackIntegerValue: 1.
+ 	maskBits _ interpreterProxy stackValue: 2.
+ 	dataBits _ interpreterProxy stackValue: 3.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	dataSize _ interpreterProxy slotSizeOf: dataBits.
+ 	maskSize _ interpreterProxy slotSizeOf: maskBits.
+ 
+ 	dataSize = maskSize ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	shiftAmount < -32 ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	shiftAmount > 8 ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	dOrigin _ interpreterProxy firstIndexableField: dataBits.
+ 	mOrigin _ interpreterProxy firstIndexableField: maskBits.
+ 
+ 	highMask _ 16rFF000000.
+ 	0 to: dataSize -1 do: [:i |
+ 		data _ dOrigin at: i.
+ 		alpha _ data bitShift: shiftAmount.
+ 		(alpha > 255) ifTrue: [alpha _ 255].
+ 		(alpha < 0) ifTrue: [alpha _ 0].
+ 		mOrigin at: i put: (((alpha << 24) bitAnd: highMask) bitOr: pixel).
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>makeMaskLog (in category 'primitives') -----
+ makeMaskLog
+ 
+ 	| max pixel maskBits dataBits dataSize maskSize dOrigin mOrigin data alpha highMask maxLog maxOop maxFirst |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'dOrigin' declareC: 'unsigned int* dOrigin'.
+ 	self var: 'mOrigin' declareC: 'unsigned int* mOrigin'.
+ 	self var: 'highMask' declareC: 'unsigned int highMask'.
+ 	self var: 'maxFirst' declareC: 'unsigned int* maxFirst'.
+ 	self var: 'max' declareC: 'unsigned int max'.
+ 	self var: 'alpha' declareC: 'unsigned int alpha'.
+ 	self var: 'pixel' declareC: 'unsigned int pixel'.
+ 	self var: 'maxLog' declareC: 'double maxLog'.
+ 
+ 	maxOop _ interpreterProxy stackValue: 0.
+ 	pixel _ interpreterProxy stackIntegerValue: 1.
+ 	maskBits _ interpreterProxy stackValue: 2.
+ 	dataBits _ interpreterProxy stackValue: 3.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	maxFirst _ (interpreterProxy firstIndexableField: maxOop).
+ 	max _ maxFirst at: 0.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	maxLog _ self cCode: 'log(max)' inSmalltalk: [max ln].
+ 
+ 	dataSize _ interpreterProxy slotSizeOf: dataBits.
+ 	maskSize _ interpreterProxy slotSizeOf: maskBits.
+ 
+ 	dataSize = maskSize ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	dOrigin _ interpreterProxy firstIndexableField: dataBits.
+ 	mOrigin _ interpreterProxy firstIndexableField: maskBits.
+ 
+ 	highMask _ 16rFF000000.
+ 	0 to: dataSize -1 do: [:i |
+ 		data _ dOrigin at: i.
+ 		data = 0 ifTrue: [alpha _ 0] ifFalse: [
+ 			alpha _ ((255.0 / maxLog) * (self cCode: 'log(data)' inSmalltalk: [data ln])) asInteger.
+ 		].
+ 		(alpha > 255) ifTrue: [alpha _ 255].
+ 		mOrigin at: i put: (((alpha << 24) bitAnd: highMask) bitOr: pixel).
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>makeTurtlesMap (in category 'primitives') -----
+ makeTurtlesMap
+ 
+ 	| height width yOop xOop whoOop mapOop size xArray yArray whoArray map x y mapIndex |
+ 	self export: true.
+ 	self inline: true.
+ 
+ 	self var: 'xArray' declareC: 'float *xArray'.
+ 	self var: 'yArray' declareC: 'float *yArray'.
+ 	self var: 'whoArray' declareC: 'unsigned int *whoArray'.
+ 	self var: 'map' declareC: 'unsigned int *map'.
+ 
+ 	height _ interpreterProxy stackIntegerValue: 0.
+ 	width _ interpreterProxy stackIntegerValue: 1.
+ 	yOop _ interpreterProxy stackValue: 2.
+ 	xOop _ interpreterProxy stackValue: 3.
+ 	whoOop _ interpreterProxy stackValue: 4.
+ 	mapOop _ interpreterProxy stackValue: 5.
+ 
+ 	(interpreterProxy isWords: yOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: xOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: whoOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: mapOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	size _ interpreterProxy slotSizeOf: whoOop.
+ 	(interpreterProxy slotSizeOf: xOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy slotSizeOf: yOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy slotSizeOf: mapOop) ~= (height * width) ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	xArray _ interpreterProxy firstIndexableField: xOop.
+ 	yArray _ interpreterProxy firstIndexableField: yOop.
+ 	whoArray _ interpreterProxy firstIndexableField: whoOop.
+ 	map _ interpreterProxy firstIndexableField: mapOop.
+ 	
+ 	0 to: (height * width) - 1 do: [:index |
+ 		map at: index put: 0.
+ 	].
+ 
+ 	0 to: size - 1 do: [:index |
+ 		x _ xArray at: index.
+ 		y _ yArray at: index.
+ 		mapIndex _ (width * y) + x.
+ 		(mapIndex >= 0  and: [mapIndex < (height * width)]) ifTrue: [
+ 			map at: mapIndex put: (whoArray at: index).
+ 		].
+ 	].
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 6.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primPixelAtXY (in category 'primitives') -----
+ primPixelAtXY
+ 
+ 	| height width yPos xPos bitsOop x y bits index ret |
+ 	self export: true.
+ 	self inline: true.
+ 
+ 	self var: 'bits' declareC: 'unsigned int *bits'.
+ 	self var: 'xPos' declareC: 'double xPos'.
+ 	self var: 'yPos' declareC: 'double yPos'.
+ 
+ 	height _ interpreterProxy stackIntegerValue: 0.
+ 	width _ interpreterProxy stackIntegerValue: 1.
+ 	yPos _ interpreterProxy stackFloatValue: 2.
+ 	xPos _ interpreterProxy stackFloatValue: 3.
+ 	bitsOop _ interpreterProxy stackValue: 4.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isWords: bitsOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy slotSizeOf: bitsOop) ~= (height * width) ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	x _ xPos.
+ 	y _ yPos.
+ 	bits _ interpreterProxy firstIndexableField: bitsOop.
+ 
+ 	((x >= 0) &  (x < width) & (y >= 0) & (y < height)) ifTrue: [
+ 		index _ y * width + x.
+ 		ret _ bits at: index.
+ 	] ifFalse: [
+ 		ret _ 0.
+ 	].
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 6.
+ 	interpreterProxy pushInteger: ret.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primPixelAtXYPut (in category 'primitives') -----
+ primPixelAtXYPut
+ 
+ 	| height width value yPos xPos bitsOop x y v bits index |
+ 	self export: true.
+ 	self inline: true.
+ 
+ 	self var: 'bits' declareC: 'unsigned int *bits'.
+ 	self var: 'xPos' declareC: 'double xPos'.
+ 	self var: 'yPos' declareC: 'double yPos'.
+ 
+ 	height _ interpreterProxy stackIntegerValue: 0.
+ 	width _ interpreterProxy stackIntegerValue: 1.
+ 	value _ interpreterProxy stackIntegerValue: 2.
+ 	yPos _ interpreterProxy stackFloatValue: 3.
+ 	xPos _ interpreterProxy stackFloatValue: 4.
+ 	bitsOop _ interpreterProxy stackValue: 5.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isWords: bitsOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy slotSizeOf: bitsOop) ~= (height * width) ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	x _ xPos.
+ 	y _ yPos.
+ 	v _ value.
+ 	v > 16r3FFFFFFF ifTrue: [
+ 		v _ 16r3FFFFFFF.
+ 	].
+ 	v < 0 ifTrue: [
+ 		v _ 0.
+ 	].
+ 
+ 	bits _ interpreterProxy firstIndexableField: bitsOop.
+ 
+ 	((x >= 0) &  (x < width) & (y >= 0) & (y < height)) ifTrue: [
+ 		index _ y * width + x.
+ 		bits at: index put: v.
+ 	].
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 6.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primPixelsAtXY (in category 'primitives') -----
+ primPixelsAtXY
+ 
+ 	| yArray xArray bitsHeight bitsWidth bitsOop bits size x y bitsIndex destWordsOop  yArrayOop xArrayOop destWords  |
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'destWords' declareC: 'unsigned int *destWords'.
+ 	self var: 'bits' declareC: 'unsigned int *bits'.
+ 	self var: 'xArray' declareC: 'float *xArray'.
+ 	self var: 'yArray' declareC: 'float *yArray'.
+ 
+ 	destWordsOop _ interpreterProxy stackValue: 0.
+ 	bitsHeight _ interpreterProxy stackIntegerValue: 1.
+ 	bitsWidth _ interpreterProxy stackIntegerValue: 2.
+ 	bitsOop _ interpreterProxy stackValue: 3.
+ 	yArrayOop _ interpreterProxy stackValue: 4.
+ 	xArrayOop _ interpreterProxy stackValue: 5.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isWords: destWordsOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: xArrayOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: yArrayOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: bitsOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	(bitsHeight * bitsWidth) ~= (interpreterProxy slotSizeOf: bitsOop) ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	size _ interpreterProxy slotSizeOf: xArrayOop.
+ 	(interpreterProxy slotSizeOf: yArrayOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy slotSizeOf: destWordsOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	xArray _ interpreterProxy firstIndexableField: xArrayOop.
+ 	yArray _ interpreterProxy firstIndexableField: yArrayOop.
+ 	destWords _ interpreterProxy firstIndexableField: destWordsOop.
+ 	bits _ interpreterProxy firstIndexableField: bitsOop.
+ 
+ 	0 to: size - 1 do: [:i |
+ 		x _ self cCoerce: (xArray at: i) to: 'int'.
+ 		self cCode: '' inSmalltalk: [x _ x asInteger].
+ 		y _ self cCoerce: (yArray at: i) to: 'int'.
+ 		self cCode: '' inSmalltalk: [y _ y asInteger].
+ 		(((x >= 0) and: [y >= 0]) and: [(x < bitsWidth) and: [y < bitsHeight]]) ifTrue: [
+ 			bitsIndex _ ((y * bitsWidth) + x).
+ 			destWords at: i put: (bits at: bitsIndex).
+ 		]
+ 	].
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 6.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primScalarForward (in category 'primitives') -----
+ primScalarForward
+ 
+ 	| bottomEdgeMode topEdgeMode rightEdgeMode leftEdgeMode destHeight destWidth headingOop yOop xOop size xArray yArray headingArray val dist newX newY index i |
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'xArray' declareC: 'float *xArray'.
+ 	self var: 'yArray' declareC: 'float *yArray'.
+ 	self var: 'headingArray' declareC: 'float *headingArray'.
+ 	self var: 'val' declareC: 'double val'.
+ 	self var: 'destHeight' declareC: 'double destHeight'.
+ 	self var: 'destWidth' declareC: 'double destWidth'.
+ 	self var: 'dist' declareC: 'double dist'.
+ 	self var: 'newX' declareC: 'double newX'.
+ 	self var: 'newY' declareC: 'double newY'.
+ 
+ 	bottomEdgeMode _ interpreterProxy stackIntegerValue: 0.
+ 	topEdgeMode _ interpreterProxy stackIntegerValue: 1.
+ 	rightEdgeMode _ interpreterProxy stackIntegerValue: 2.
+ 	leftEdgeMode _ interpreterProxy stackIntegerValue: 3.
+ 	destHeight _ interpreterProxy stackFloatValue: 4.
+ 	destWidth _ interpreterProxy stackFloatValue: 5.
+ 	val _ interpreterProxy stackFloatValue: 6.
+ 	headingOop _ interpreterProxy stackValue: 7.
+ 	yOop _ interpreterProxy stackValue: 8.
+ 	xOop _ interpreterProxy stackValue: 9.
+ 	index _ interpreterProxy stackIntegerValue: 10.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isWords: xOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: yOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: headingOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	size _ interpreterProxy slotSizeOf: xOop.
+ 	(interpreterProxy slotSizeOf: yOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy slotSizeOf: headingOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	xArray _ interpreterProxy firstIndexableField: xOop.
+ 	yArray _ interpreterProxy firstIndexableField: yOop.
+ 	headingArray _ interpreterProxy firstIndexableField: headingOop.
+ 
+ 	dist _ val.
+ 	i _ index - 1.
+ 	newX _ (xArray at: i) + (dist * (headingArray at: i) cos).
+ 	newY _ (yArray at: i) - (dist * (headingArray at: i) sin).
+ 	self scalarXAt: i xArray: xArray headingArray: headingArray value: newX destWidth: destWidth leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode.
+ 	self scalarYAt: i yArray: yArray headingArray: headingArray value: newY destHeight: destHeight topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 11.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primSetPixelsAtXY (in category 'primitives') -----
+ primSetPixelsAtXY
+ 
+ 	| yArray xArray bitsHeight bitsWidth bitsOop bits size x y bitsIndex  yArrayOop xArrayOop  valueOop isValueInt isValueWordArray intValue wordsValue value pArrayOop pArray floatsValue fv |
+ 	self export: true.
+ 	self inline: true.	
+ 	self var: 'intValue' declareC: 'unsigned int intValue'.
+ 	self var: 'wordsValue' declareC: 'unsigned int *wordsValue'.
+ 	self var: 'floatsValue' declareC: 'float *floatsValue'.
+ 	self var: 'value' declareC: 'unsigned int value'.
+ 	self var: 'floatValue' declareC: 'float floatValue'.
+ 	self var: 'bits' declareC: 'unsigned int *bits'.
+ 	self var: 'pArray' declareC: 'unsigned char *pArray'.
+ 	self var: 'xArray' declareC: 'float *xArray'.
+ 	self var: 'yArray' declareC: 'float *yArray'.
+ 
+ 	valueOop _ interpreterProxy stackValue: 0.
+ 	bitsHeight _ interpreterProxy stackIntegerValue: 1.
+ 	bitsWidth _ interpreterProxy stackIntegerValue: 2.
+ 	bitsOop _ interpreterProxy stackValue: 3.
+ 	yArrayOop _ interpreterProxy stackValue: 4.
+ 	xArrayOop _ interpreterProxy stackValue: 5.
+ 	pArrayOop _ interpreterProxy stackValue: 6.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isBytes: pArrayOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: xArrayOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: yArrayOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: bitsOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	(bitsHeight * bitsWidth) ~= (interpreterProxy slotSizeOf: bitsOop) ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	size _ interpreterProxy slotSizeOf: xArrayOop.
+ 	(interpreterProxy slotSizeOf: pArrayOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy slotSizeOf: yArrayOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	pArray _ interpreterProxy firstIndexableField: pArrayOop.
+ 	xArray _ interpreterProxy firstIndexableField: xArrayOop.
+ 	yArray _ interpreterProxy firstIndexableField: yArrayOop.
+ 
+ 	isValueInt _ interpreterProxy isIntegerObject: valueOop.
+ 	isValueInt ifTrue: [
+ 		intValue _ interpreterProxy integerValueOf: valueOop.
+ 		value _ intValue.
+ 	] ifFalse: [
+ 		(interpreterProxy slotSizeOf: valueOop) ~= size
+ 			ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 		isValueWordArray _ (interpreterProxy is: valueOop MemberOf: 'WordArray').
+ 		isValueWordArray ifTrue: [
+ 			wordsValue _ interpreterProxy firstIndexableField: valueOop.
+ 		] ifFalse: [
+ 			floatsValue _ interpreterProxy firstIndexableField: valueOop.
+ 		].
+ 	].
+ 	bits _ interpreterProxy firstIndexableField: bitsOop.
+ 
+ 	0 to: size - 1 do: [:i |
+ 		(pArray at: i) = 1 ifTrue: [
+ 			x _ self cCoerce: (xArray at: i) to: 'int'.
+ 			self cCode: '' inSmalltalk: [x _ x asInteger].
+ 			y _ self cCoerce: (yArray at: i) to: 'int'.
+ 			self cCode: '' inSmalltalk: [y _ y asInteger].
+ 			(((x >= 0) and: [y >= 0]) and: [(x < bitsWidth) and: [y < bitsHeight]]) ifTrue: [
+ 				bitsIndex _ ((y * bitsWidth) + x).
+ 				isValueInt ifFalse: [
+ 					isValueWordArray ifTrue: [
+ 						bits at: bitsIndex put: (wordsValue at: i).
+ 					] ifFalse: [
+ 						fv _ floatsValue at: i.
+ 						self cCode: '' inSmalltalk: [fv _ fv asInteger].
+ 						bits at: bitsIndex put: fv.
+ 					].
+ 				] ifTrue: [
+ 					bits at: bitsIndex put: value.
+ 				].
+ 			]
+ 		].
+ 	].
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 7.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primTurtlesForward (in category 'primitives') -----
+ primTurtlesForward
+ 
+ 	| bottomEdgeMode topEdgeMode rightEdgeMode leftEdgeMode destHeight destWidth valOop headingOop yOop xOop isValVector size xArray yArray headingArray valArray val dist newX newY pOop pArray |
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'pArray' declareC: 'unsigned char *pArray'.
+ 	self var: 'xArray' declareC: 'float *xArray'.
+ 	self var: 'yArray' declareC: 'float *yArray'.
+ 	self var: 'headingArray' declareC: 'float *headingArray'.
+ 	self var: 'valArray' declareC: 'float *valArray'.
+ 	self var: 'val' declareC: 'double val'.
+ 	self var: 'destHeight' declareC: 'double destHeight'.
+ 	self var: 'destWidth' declareC: 'double destWidth'.
+ 	self var: 'dist' declareC: 'double dist'.
+ 	self var: 'newX' declareC: 'double newX'.
+ 	self var: 'newY' declareC: 'double newY'.
+ 
+ 	bottomEdgeMode _ interpreterProxy stackIntegerValue: 0.
+ 	topEdgeMode _ interpreterProxy stackIntegerValue: 1.
+ 	rightEdgeMode _ interpreterProxy stackIntegerValue: 2.
+ 	leftEdgeMode _ interpreterProxy stackIntegerValue: 3.
+ 	destHeight _ interpreterProxy stackFloatValue: 4.
+ 	destWidth _ interpreterProxy stackFloatValue: 5.
+ 	valOop _ interpreterProxy stackValue: 6.
+ 	headingOop _ interpreterProxy stackValue: 7.
+ 	yOop _ interpreterProxy stackValue: 8.
+ 	xOop _ interpreterProxy stackValue: 9.
+ 	pOop _ interpreterProxy stackValue: 10.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isBytes: pOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: xOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: yOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: headingOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isFloatObject: valOop) ifTrue: [
+ 		isValVector _ false.
+ 	] ifFalse: [
+ 		(interpreterProxy isWords: valOop) ifTrue: [
+ 			isValVector _ true
+ 		] ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	].
+ 
+ 	size _ interpreterProxy slotSizeOf: xOop.
+ 	(interpreterProxy slotSizeOf: yOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy slotSizeOf: headingOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy slotSizeOf: pOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	isValVector ifTrue: [
+ 		(interpreterProxy slotSizeOf: valOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	].
+ 
+ 	pArray _ interpreterProxy firstIndexableField: pOop.
+ 	xArray _ interpreterProxy firstIndexableField: xOop.
+ 	yArray _ interpreterProxy firstIndexableField: yOop.
+ 	headingArray _ interpreterProxy firstIndexableField: headingOop.
+ 	isValVector ifTrue: [
+ 		valArray _ interpreterProxy firstIndexableField: valOop.
+ 	] ifFalse: [
+ 		val _ interpreterProxy floatValueOf: valOop
+ 	].
+ 
+ 	0 to: size -1 do: [:i |
+ 		(pArray at: i) = 1 ifTrue: [
+ 			isValVector ifTrue: [
+ 				dist _ valArray at: i.
+ 			] ifFalse: [
+ 				dist _ val.
+ 			].
+ 			newX _ (xArray at: i) + (dist * (headingArray at: i) cos).
+ 			newY _ (yArray at: i) - (dist * (headingArray at: i) sin).
+ 			self scalarXAt: i xArray: xArray headingArray: headingArray value: newX destWidth: destWidth leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode.
+ 			self scalarYAt: i yArray: yArray headingArray: headingArray value: newY destHeight: destHeight topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode
+ 		].
+ 	].
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 11.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primUpHill (in category 'primitives') -----
+ primUpHill
+ 
+ 	| sniffRange height width bitsOop tH tY tX bits turtleX turtleY startX endX startY endY maxVal maxValX rowOffset thisVal maxValY ret |
+ 	self inline: true.
+ 	self export: true.
+ 
+ 	self var: 'bits' declareC: 'unsigned int *bits'.
+ 	self var: 'tX' declareC: 'double tX'.
+ 	self var: 'tY' declareC: 'double tY'.
+ 	self var: 'tH' declareC: 'double tH'.
+ 
+ 	sniffRange _ interpreterProxy stackIntegerValue: 0.
+ 	height _ interpreterProxy stackIntegerValue: 1.
+ 	width _ interpreterProxy stackIntegerValue: 2.
+ 	bitsOop _ interpreterProxy stackValue: 3.
+ 	tH _ interpreterProxy stackFloatValue: 4.
+ 	tY _ interpreterProxy stackFloatValue: 5.
+ 	tX _ interpreterProxy stackFloatValue: 6.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	(interpreterProxy isWords: bitsOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy slotSizeOf: bitsOop) ~= (height * width) ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	bits _ interpreterProxy firstIndexableField: bitsOop.
+ 
+ 	turtleX _ self cCode: 'tX' inSmalltalk: [tX asInteger].
+ 	turtleY _ self cCode: 'tY' inSmalltalk: [tY asInteger].
+ 	turtleX _ turtleX max: 0.
+ 	turtleY _ turtleY max: 0.
+ 	turtleX _ turtleX min: width - 1.
+ 	turtleY _ turtleY min: height - 1.
+ 	startX _ turtleX - sniffRange max: 0.
+ 	endX _ (turtleX + sniffRange) min: (width - 1).
+ 	startY _ (turtleY - sniffRange) max: 0.
+ 	endY _ (turtleY + sniffRange) min: (height - 1).
+ 	maxVal _ bits at: turtleY * width + turtleX.
+ 	maxValX _ -1.
+ 	startY to: endY do: [:y | 
+ 		rowOffset _ y * width.
+ 		startX to: endX do: [:x | 
+ 			thisVal _ bits at: rowOffset + x.
+ 			thisVal > maxVal ifTrue: [
+ 				maxValX _ x.
+ 				maxValY _ y.
+ 				maxVal _ thisVal
+ 			].
+ 		].
+ 	].
+ 	-1 = maxValX
+ 		ifTrue: [ret _ self radiansToDegrees: tH]
+ 		ifFalse: [
+ 			ret _ (self degreesFromX: (self cCoerce: maxValX - turtleX to: 'double') y: (self cCoerce: maxValY - turtleY to: 'double')) + 90.0.
+ 		].
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 8.
+ 	interpreterProxy pushFloat: ret.
+ 
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveAddArrays (in category 'array arithmetic') -----
+ primitiveAddArrays
+ 
+ 	| length resultOop argOop rcvrOop isArgWords isRcvrWords wordsRcvr wordsArg wordsResult floatsArg floatsResult floatsRcvr |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #wordsArg declareC: 'unsigned int *wordsArg'.
+ 	self var: #wordsResult declareC: 'unsigned int *wordsResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatsArg declareC: 'float *floatsArg'.
+ 	self var: #floatsResult declareC: 'float *floatsResult'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackObjectValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: argOop).
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isWords: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: argOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvrOop)).
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgWords _ interpreterProxy is: argOop MemberOf: 'WordArray'.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isArgWords & isRcvrWords ifTrue: [
+ 		(interpreterProxy is: resultOop MemberOf: 'WordArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	] ifFalse: [
+ 		(interpreterProxy is: resultOop MemberOf: 'KedamaFloatArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	].
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgWords ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			wordsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				wordsResult at: i put: (wordsRcvr at: i) + (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (wordsRcvr at: i) + (floatsArg at: i).
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgWords ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (floatsRcvr at: i) + (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (floatsRcvr at: i) + (floatsArg at: i).
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveAddScalar (in category 'array arithmetic') -----
+ primitiveAddScalar
+ 
+ 	| length resultOop argOop rcvrOop isRcvrWords wordsRcvr wordsResult floatsResult floatsRcvr isArgInt intArg floatArg |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #intArg declareC: 'int intArg'.
+ 	self var: #wordsResult declareC: 'unsigned int *wordsResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatArg declareC: 'double floatArg'.
+ 	self var: #floatsResult declareC: 'float *floatsResult'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isWords: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: rcvrOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgInt _ interpreterProxy isIntegerObject: argOop.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isArgInt & isRcvrWords ifTrue: [
+ 		(interpreterProxy is: resultOop MemberOf: 'WordArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	] ifFalse: [
+ 		(interpreterProxy is: resultOop MemberOf: 'KedamaFloatArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	].
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgInt ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			wordsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				wordsResult at: i put: (wordsRcvr at: i) + intArg.
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (wordsRcvr at: i) + floatArg.
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgInt ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (floatsRcvr at: i) + intArg.
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (floatsRcvr at: i) + floatArg.
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveAndByteArray (in category 'array arithmetic') -----
+ primitiveAndByteArray
+ 
+ 	| length rcvrOop otherOop otherArray rcvrArray length1 length2 |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #rcvrArray declareC: 'unsigned char *rcvrArray'.
+ 	self var: #otherArray declareC: 'unsigned char *otherArray'.
+ 
+ 	otherOop _ interpreterProxy stackObjectValue: 0.
+ 	rcvrOop _ interpreterProxy stackValue: 1.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isBytes: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isBytes: otherOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length1 _ interpreterProxy stSizeOf: rcvrOop.
+ 	length2 _ interpreterProxy stSizeOf: otherOop.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ length1.
+ 	length1 > length2 ifTrue: [
+ 		length _ length2.
+ 	].
+ 
+ 	otherArray _ interpreterProxy firstIndexableField: otherOop.
+ 	rcvrArray _ interpreterProxy firstIndexableField: rcvrOop.
+ 	0 to: length-1 do:[:i|
+ 		rcvrArray at: i put: (((rcvrArray at: i) + (otherArray at: i)) = 2).
+ 	].
+ 	interpreterProxy pop: 1.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveDivArrays (in category 'array arithmetic') -----
+ primitiveDivArrays
+ 
+ 	| length resultOop argOop rcvrOop isArgWords isRcvrWords wordsRcvr wordsArg wordsResult floatsArg floatsResult floatsRcvr |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #wordsArg declareC: 'unsigned int *wordsArg'.
+ 	self var: #wordsResult declareC: 'unsigned int *wordsResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatsArg declareC: 'float *floatsArg'.
+ 	self var: #floatsResult declareC: 'float *floatsResult'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackObjectValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: argOop).
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isWords: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: argOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvrOop)).
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgWords _ interpreterProxy is: argOop MemberOf: 'WordArray'.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isArgWords & isRcvrWords ifTrue: [
+ 		(interpreterProxy is: resultOop MemberOf: 'WordArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	] ifFalse: [
+ 		(interpreterProxy is: resultOop MemberOf: 'KedamaFloatArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	].
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgWords ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			wordsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				wordsResult at: i put: (wordsRcvr at: i) / (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (wordsRcvr at: i) / (floatsArg at: i).
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgWords ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (floatsRcvr at: i) / (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (floatsRcvr at: i) / (floatsArg at: i).
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveDivScalar (in category 'array arithmetic') -----
+ primitiveDivScalar
+ 
+ 	| length resultOop argOop rcvrOop isRcvrWords wordsRcvr wordsResult floatsResult floatsRcvr isArgInt intArg floatArg |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #intArg declareC: 'int intArg'.
+ 	self var: #wordsResult declareC: 'unsigned int *wordsResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatArg declareC: 'double floatArg'.
+ 	self var: #floatsResult declareC: 'float *floatsResult'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isWords: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: rcvrOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgInt _ interpreterProxy isIntegerObject: argOop.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isArgInt & isRcvrWords ifTrue: [
+ 		(interpreterProxy is: resultOop MemberOf: 'WordArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	] ifFalse: [
+ 		(interpreterProxy is: resultOop MemberOf: 'KedamaFloatArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	].
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgInt ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			wordsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				wordsResult at: i put: (wordsRcvr at: i) // intArg.
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (wordsRcvr at: i) / floatArg.
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgInt ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (floatsRcvr at: i) / intArg.
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (floatsRcvr at: i) / floatArg.
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveEQArrays (in category 'array arithmetic') -----
+ primitiveEQArrays
+ 
+ 	| length resultOop argOop rcvrOop isArgWords isRcvrWords wordsRcvr wordsArg floatsArg floatsRcvr bytesResult |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #wordsArg declareC: 'unsigned int *wordsArg'.
+ 	self var: #bytesResult declareC: 'unsigned char *bytesResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatsArg declareC: 'float *floatsArg'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackObjectValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: argOop).
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isBytes: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: argOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvrOop)).
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgWords _ interpreterProxy is: argOop MemberOf: 'WordArray'.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgWords ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) = (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) = (floatsArg at: i).
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgWords ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) = (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) = (floatsArg at: i).
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveEQScalar (in category 'array arithmetic') -----
+ primitiveEQScalar
+ 
+ 	| length resultOop argOop rcvrOop isRcvrWords wordsRcvr floatsRcvr isArgInt intArg floatArg bytesResult |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #intArg declareC: 'int intArg'.
+ 	self var: #bytesResult declareC: 'unsigned char *bytesResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatArg declareC: 'double floatArg'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isBytes: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: rcvrOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgInt _ interpreterProxy isIntegerObject: argOop.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgInt ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) = intArg.
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) = floatArg.
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgInt ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) = intArg.
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) = floatArg.
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveGEArrays (in category 'array arithmetic') -----
+ primitiveGEArrays
+ 
+ 	| length resultOop argOop rcvrOop isArgWords isRcvrWords wordsRcvr wordsArg floatsArg floatsRcvr bytesResult |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #wordsArg declareC: 'unsigned int *wordsArg'.
+ 	self var: #bytesResult declareC: 'unsigned char *bytesResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatsArg declareC: 'float *floatsArg'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackObjectValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: argOop).
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isBytes: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: argOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvrOop)).
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgWords _ interpreterProxy is: argOop MemberOf: 'WordArray'.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgWords ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) >= (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) >= (floatsArg at: i).
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgWords ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) >= (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) >= (floatsArg at: i).
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveGEScalar (in category 'array arithmetic') -----
+ primitiveGEScalar
+ 
+ 	| length resultOop argOop rcvrOop isRcvrWords wordsRcvr floatsRcvr isArgInt intArg floatArg bytesResult |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #intArg declareC: 'int intArg'.
+ 	self var: #bytesResult declareC: 'unsigned char *bytesResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatArg declareC: 'double floatArg'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isBytes: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: rcvrOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgInt _ interpreterProxy isIntegerObject: argOop.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgInt ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) >= intArg.
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) >= floatArg.
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgInt ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) >= intArg.
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) >= floatArg.
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveGTArrays (in category 'array arithmetic') -----
+ primitiveGTArrays
+ 
+ 	| length resultOop argOop rcvrOop isArgWords isRcvrWords wordsRcvr wordsArg floatsArg floatsRcvr bytesResult |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #wordsArg declareC: 'unsigned int *wordsArg'.
+ 	self var: #bytesResult declareC: 'unsigned char *bytesResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatsArg declareC: 'float *floatsArg'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackObjectValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: argOop).
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isBytes: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: argOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvrOop)).
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgWords _ interpreterProxy is: argOop MemberOf: 'WordArray'.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgWords ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) > (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) > (floatsArg at: i).
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgWords ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) > (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) > (floatsArg at: i).
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveGTScalar (in category 'array arithmetic') -----
+ primitiveGTScalar
+ 
+ 	| length resultOop argOop rcvrOop isRcvrWords wordsRcvr floatsRcvr isArgInt intArg floatArg bytesResult |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #intArg declareC: 'int intArg'.
+ 	self var: #bytesResult declareC: 'unsigned char *bytesResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatArg declareC: 'double floatArg'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isBytes: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: rcvrOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgInt _ interpreterProxy isIntegerObject: argOop.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgInt ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) > intArg.
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) > floatArg.
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgInt ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) > intArg.
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) > floatArg.
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveLEArrays (in category 'array arithmetic') -----
+ primitiveLEArrays
+ 
+ 	| length resultOop argOop rcvrOop isArgWords isRcvrWords wordsRcvr wordsArg floatsArg floatsRcvr bytesResult |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #wordsArg declareC: 'unsigned int *wordsArg'.
+ 	self var: #bytesResult declareC: 'unsigned char *bytesResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatsArg declareC: 'float *floatsArg'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackObjectValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: argOop).
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isBytes: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: argOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvrOop)).
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgWords _ interpreterProxy is: argOop MemberOf: 'WordArray'.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgWords ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) <= (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) <= (floatsArg at: i).
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgWords ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) <= (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) <= (floatsArg at: i).
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveLEScalar (in category 'array arithmetic') -----
+ primitiveLEScalar
+ 
+ 	| length resultOop argOop rcvrOop isRcvrWords wordsRcvr floatsRcvr isArgInt intArg floatArg bytesResult |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #intArg declareC: 'int intArg'.
+ 	self var: #bytesResult declareC: 'unsigned char *bytesResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatArg declareC: 'double floatArg'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isBytes: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: rcvrOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgInt _ interpreterProxy isIntegerObject: argOop.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgInt ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) <= intArg.
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) <= floatArg.
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgInt ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) <= intArg.
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) <= floatArg.
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveLTArrays (in category 'array arithmetic') -----
+ primitiveLTArrays
+ 
+ 	| length resultOop argOop rcvrOop isArgWords isRcvrWords wordsRcvr wordsArg floatsArg floatsRcvr bytesResult |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #wordsArg declareC: 'unsigned int *wordsArg'.
+ 	self var: #bytesResult declareC: 'unsigned char *bytesResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatsArg declareC: 'float *floatsArg'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackObjectValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: argOop).
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isBytes: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: argOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvrOop)).
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgWords _ interpreterProxy is: argOop MemberOf: 'WordArray'.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgWords ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) < (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) < (floatsArg at: i).
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgWords ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) < (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) < (floatsArg at: i).
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveLTScalar (in category 'array arithmetic') -----
+ primitiveLTScalar
+ 
+ 	| length resultOop argOop rcvrOop isRcvrWords wordsRcvr floatsRcvr isArgInt intArg floatArg bytesResult |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #intArg declareC: 'int intArg'.
+ 	self var: #bytesResult declareC: 'unsigned char *bytesResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatArg declareC: 'double floatArg'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isBytes: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: rcvrOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgInt _ interpreterProxy isIntegerObject: argOop.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgInt ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) < intArg.
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) < floatArg.
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgInt ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) < intArg.
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) < floatArg.
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveMulArrays (in category 'array arithmetic') -----
+ primitiveMulArrays
+ 
+ 	| length resultOop argOop rcvrOop isArgWords isRcvrWords wordsRcvr wordsArg wordsResult floatsArg floatsResult floatsRcvr |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #wordsArg declareC: 'unsigned int *wordsArg'.
+ 	self var: #wordsResult declareC: 'unsigned int *wordsResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatsArg declareC: 'float *floatsArg'.
+ 	self var: #floatsResult declareC: 'float *floatsResult'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackObjectValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: argOop).
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isWords: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: argOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvrOop)).
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgWords _ interpreterProxy is: argOop MemberOf: 'WordArray'.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isArgWords & isRcvrWords ifTrue: [
+ 		(interpreterProxy is: resultOop MemberOf: 'WordArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	] ifFalse: [
+ 		(interpreterProxy is: resultOop MemberOf: 'KedamaFloatArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	].
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgWords ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			wordsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				wordsResult at: i put: (wordsRcvr at: i) * (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (wordsRcvr at: i) * (floatsArg at: i).
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgWords ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (floatsRcvr at: i) * (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (floatsRcvr at: i) * (floatsArg at: i).
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveMulScalar (in category 'array arithmetic') -----
+ primitiveMulScalar
+ 
+ 	| length resultOop argOop rcvrOop isRcvrWords wordsRcvr wordsResult floatsResult floatsRcvr isArgInt intArg floatArg |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #intArg declareC: 'int intArg'.
+ 	self var: #wordsResult declareC: 'unsigned int *wordsResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatArg declareC: 'double floatArg'.
+ 	self var: #floatsResult declareC: 'float *floatsResult'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isWords: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: rcvrOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgInt _ interpreterProxy isIntegerObject: argOop.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isArgInt & isRcvrWords ifTrue: [
+ 		(interpreterProxy is: resultOop MemberOf: 'WordArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	] ifFalse: [
+ 		(interpreterProxy is: resultOop MemberOf: 'KedamaFloatArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	].
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgInt ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			wordsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				wordsResult at: i put: (wordsRcvr at: i) * intArg.
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (wordsRcvr at: i) * floatArg.
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgInt ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (floatsRcvr at: i) * intArg.
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (floatsRcvr at: i) * floatArg.
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveNEArrays (in category 'array arithmetic') -----
+ primitiveNEArrays
+ 
+ 	| length resultOop argOop rcvrOop isArgWords isRcvrWords wordsRcvr wordsArg floatsArg floatsRcvr bytesResult |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #wordsArg declareC: 'unsigned int *wordsArg'.
+ 	self var: #bytesResult declareC: 'unsigned char *bytesResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatsArg declareC: 'float *floatsArg'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackObjectValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: argOop).
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isBytes: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: argOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvrOop)).
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgWords _ interpreterProxy is: argOop MemberOf: 'WordArray'.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgWords ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) ~= (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) ~= (floatsArg at: i).
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgWords ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) ~= (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) ~= (floatsArg at: i).
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveNEScalar (in category 'array arithmetic') -----
+ primitiveNEScalar
+ 
+ 	| length resultOop argOop rcvrOop isRcvrWords wordsRcvr floatsRcvr isArgInt intArg floatArg bytesResult |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #intArg declareC: 'int intArg'.
+ 	self var: #bytesResult declareC: 'unsigned char *bytesResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatArg declareC: 'double floatArg'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isBytes: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: rcvrOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgInt _ interpreterProxy isIntegerObject: argOop.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgInt ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) ~= intArg.
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (wordsRcvr at: i) ~= floatArg.
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgInt ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) ~= intArg.
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			bytesResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				bytesResult at: i put: (floatsRcvr at: i) ~= floatArg.
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveNotByteArray (in category 'array arithmetic') -----
+ primitiveNotByteArray
+ 
+ 	| length rcvrOop rcvrArray |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #rcvrArray declareC: 'unsigned char *rcvrArray'.
+ 
+ 	rcvrOop _ interpreterProxy stackValue: 0.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isBytes: rcvrOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: rcvrOop.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	rcvrArray _ interpreterProxy firstIndexableField: rcvrOop.
+ 	0 to: length-1 do:[:i|
+ 		(rcvrArray at: i) = 0 ifTrue: [
+ 			rcvrArray at: i put: 1
+ 		] ifFalse: [
+ 			rcvrArray at: i put: 0
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveOrByteArray (in category 'array arithmetic') -----
+ primitiveOrByteArray
+ 
+ 	| length rcvrOop otherOop otherArray rcvrArray length1 length2 |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #rcvrArray declareC: 'unsigned char *rcvrArray'.
+ 	self var: #otherArray declareC: 'unsigned char *otherArray'.
+ 
+ 	otherOop _ interpreterProxy stackObjectValue: 0.
+ 	rcvrOop _ interpreterProxy stackValue: 1.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isBytes: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isBytes: otherOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length1 _ interpreterProxy stSizeOf: rcvrOop.
+ 	length2 _ interpreterProxy stSizeOf: otherOop.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ length1.
+ 	length1 > length2 ifTrue: [
+ 		length _ length2.
+ 	].
+ 
+ 	otherArray _ interpreterProxy firstIndexableField: otherOop.
+ 	rcvrArray _ interpreterProxy firstIndexableField: rcvrOop.
+ 	0 to: length-1 do:[:i|
+ 		rcvrArray at: i put: (((rcvrArray at: i) + (otherArray at: i)) > 0).
+ 	].
+ 	interpreterProxy pop: 1.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitivePredicateAtAllPutBoolean (in category 'predicated array primitive') -----
+ primitivePredicateAtAllPutBoolean
+ 
+ 	| rcvrOop valOop val valuesOop values predicatesOop predicates |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #values declareC: 'unsigned char *values'.
+ 	self var: #predicates declareC: 'unsigned char *predicates'.
+ 
+ 	valOop _ interpreterProxy stackValue: 0.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 1.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isIntegerValue: valOop) ifTrue: [
+ 		val _ interpreterProxy integerValueOf: valOop.
+ 	] ifFalse: [
+ 		val _ interpreterProxy booleanValueOf: valOop.
+ 	].
+ 
+ 	valuesOop _ interpreterProxy fetchPointer: 1 ofObject: rcvrOop.
+ 	predicatesOop _ interpreterProxy fetchPointer: 0 ofObject: rcvrOop.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	(interpreterProxy isBytes: predicatesOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isBytes: valuesOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	values _ interpreterProxy firstIndexableField: valuesOop.
+ 	predicates _ interpreterProxy firstIndexableField: predicatesOop.
+ 	
+ 	0 to: (interpreterProxy stSizeOf: valuesOop) - 1 do:[:i |
+ 		(predicates at: i) = 1 ifTrue: [
+ 			values at: i put: val
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 1.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitivePredicateAtAllPutColor (in category 'predicated array primitive') -----
+ primitivePredicateAtAllPutColor
+ 
+ 	| rcvrOop val valuesOop values predicatesOop predicates |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #values declareC: 'unsigned int *values'.
+ 	self var: #val declareC: 'unsigned int val'.
+ 	self var: #predicates declareC: 'unsigned char *predicates'.
+ 
+ 	val _ interpreterProxy stackIntegerValue: 0.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 1.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	val _ val bitOr: 16rFF000000.
+ 
+ 	valuesOop _ interpreterProxy fetchPointer: 1 ofObject: rcvrOop.
+ 	predicatesOop _ interpreterProxy fetchPointer: 0 ofObject: rcvrOop.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	(interpreterProxy isBytes: predicatesOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: valuesOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	values _ interpreterProxy firstIndexableField: valuesOop.
+ 	predicates _ interpreterProxy firstIndexableField: predicatesOop.
+ 	
+ 	0 to: (interpreterProxy stSizeOf: valuesOop) - 1 do:[:i |
+ 		(predicates at: i) = 1 ifTrue: [
+ 			values at: i put: val
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 1.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitivePredicateAtAllPutNumber (in category 'predicated array primitive') -----
+ primitivePredicateAtAllPutNumber
+ 
+ 	| rcvrOop val valuesOop values predicatesOop predicates |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #values declareC: 'float *values'.
+ 	self var: #val declareC: 'float val'.
+ 	self var: #predicates declareC: 'unsigned char *predicates'.
+ 
+ 	val _ interpreterProxy stackFloatValue: 0.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 1.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	valuesOop _ interpreterProxy fetchPointer: 1 ofObject: rcvrOop.
+ 	predicatesOop _ interpreterProxy fetchPointer: 0 ofObject: rcvrOop.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	(interpreterProxy isBytes: predicatesOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: valuesOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	values _ interpreterProxy firstIndexableField: valuesOop.
+ 	predicates _ interpreterProxy firstIndexableField: predicatesOop.
+ 	
+ 	0 to: (interpreterProxy stSizeOf: valuesOop) - 1 do:[:i |
+ 		(predicates at: i) = 1 ifTrue: [
+ 			values at: i put: val
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 1.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitivePredicateAtAllPutObject (in category 'predicated array primitive') -----
+ primitivePredicateAtAllPutObject
+ 
+ 	| rcvrOop valOop valuesOop values predicatesOop predicates |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #values declareC: 'int *values'.
+ 	self var: #predicates declareC: 'unsigned char *predicates'.
+ 
+ 	valOop _ interpreterProxy stackValue: 0.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 1.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	valuesOop _ interpreterProxy fetchPointer: 1 ofObject: rcvrOop.
+ 	predicatesOop _ interpreterProxy fetchPointer: 0 ofObject: rcvrOop.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	(interpreterProxy isBytes: predicatesOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isPointers: valuesOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	values _ interpreterProxy firstIndexableField: valuesOop.
+ 	predicates _ interpreterProxy firstIndexableField: predicatesOop.
+ 	
+ 	0 to: (interpreterProxy stSizeOf: valuesOop) - 1 do:[:i |
+ 		(predicates at: i) = 1 ifTrue: [
+ 			values at: i put: valOop
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 1.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitivePredicateReplaceBytes (in category 'predicated array primitive') -----
+ primitivePredicateReplaceBytes
+ 
+ 	| rcvrOop valuesOop values predicatesOop predicates repStart repOop stop start replacement valuesSize predicatesSize replacementSize |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #values declareC: 'unsigned char *values'.
+ 	self var: #predicates declareC: 'unsigned char *predicates'.
+ 	self var: #replacement declareC: 'unsigned char *replacement'.
+ 
+ 	repStart _ interpreterProxy stackIntegerValue: 0.
+ 	repOop _ interpreterProxy stackObjectValue: 1.
+ 	stop _ interpreterProxy stackIntegerValue: 2.
+ 	start _ interpreterProxy stackIntegerValue: 3.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 4.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	valuesOop _ interpreterProxy fetchPointer: 1 ofObject: rcvrOop.
+ 	predicatesOop _ interpreterProxy fetchPointer: 0 ofObject: rcvrOop.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	(interpreterProxy isBytes: predicatesOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	((interpreterProxy isBytes: valuesOop) and: [interpreterProxy isBytes: repOop])
+ 		ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	values _ interpreterProxy firstIndexableField: valuesOop.
+ 	predicates _ interpreterProxy firstIndexableField: predicatesOop.
+ 	replacement _ interpreterProxy firstIndexableField: repOop.
+ 	valuesSize _ interpreterProxy stSizeOf: valuesOop.
+ 	predicatesSize _ interpreterProxy stSizeOf: predicatesOop.
+ 	replacementSize _ interpreterProxy stSizeOf: repOop.
+ 
+ 	start > stop ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	start < 1 ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	start > valuesSize ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	start > predicatesSize ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	stop > valuesSize ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	stop > predicatesSize ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	repStart < 1 ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	repStart > replacementSize ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	(replacementSize - repStart + 1) < (stop - start + 1) ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	
+ 	start - 1 to: stop - 1 do: [:i |
+ 		(predicates at: i) = 1 ifTrue: [
+ 			values at: i put: (replacement at: repStart + i - start).
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitivePredicateReplaceWords (in category 'predicated array primitive') -----
+ primitivePredicateReplaceWords
+ 
+ 	| rcvrOop valuesOop values predicatesOop predicates repStart repOop stop start replacement valuesSize predicatesSize replacementSize vIsFloat rIsFloat floatValues floatReplacement fv |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #values declareC: 'unsigned int *values'.
+ 	self var: #floatValues declareC: 'float *floatValues'.
+ 	self var: #predicates declareC: 'unsigned char *predicates'.
+ 	self var: #replacement declareC: 'unsigned int *replacement'.
+ 	self var: #floatReplacement declareC: 'float *floatReplacement'.
+ 	self var: #fv declareC: 'unsigned int fv'.
+ 
+ 	repStart _ interpreterProxy stackIntegerValue: 0.
+ 	repOop _ interpreterProxy stackObjectValue: 1.
+ 	stop _ interpreterProxy stackIntegerValue: 2.
+ 	start _ interpreterProxy stackIntegerValue: 3.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 4.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	valuesOop _ interpreterProxy fetchPointer: 1 ofObject: rcvrOop.
+ 	predicatesOop _ interpreterProxy fetchPointer: 0 ofObject: rcvrOop.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	(interpreterProxy isBytes: predicatesOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(((interpreterProxy isWords: valuesOop) and: [interpreterProxy isWords: repOop]) or: [
+ 		(interpreterProxy isPointers: valuesOop) and: [interpreterProxy isPointers: repOop]]) 
+ 			ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	predicates _ interpreterProxy firstIndexableField: predicatesOop.
+ 	valuesSize _ interpreterProxy stSizeOf: valuesOop.
+ 	predicatesSize _ interpreterProxy stSizeOf: predicatesOop.
+ 	replacementSize _ interpreterProxy stSizeOf: repOop.
+ 
+ 	start > stop ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	start < 1 ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	start > valuesSize ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	start > predicatesSize ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	stop > valuesSize ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	stop > predicatesSize ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	repStart < 1 ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	repStart > replacementSize ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	(replacementSize - repStart + 1) < (stop - start + 1) ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	vIsFloat _ interpreterProxy is: valuesOop MemberOf: 'KedamaFloatArray'.
+ 	rIsFloat _ interpreterProxy is: repOop MemberOf: 'KedamaFloatArray'.
+ 	(vIsFloat and: [rIsFloat]) ifTrue: [
+ 		floatValues _ interpreterProxy firstIndexableField: valuesOop.
+ 		floatReplacement _  interpreterProxy firstIndexableField: repOop.
+ 		start - 1 to: stop - 1 do: [:i |
+ 			(predicates at: i) = 1 ifTrue: [
+ 				floatValues at: i put: (floatReplacement at: repStart + i - start).
+ 			].
+ 		].
+ 	].
+ 	(vIsFloat and: [rIsFloat not]) ifTrue: [
+ 		floatValues _ interpreterProxy firstIndexableField: valuesOop.
+ 		replacement _  interpreterProxy firstIndexableField: repOop.
+ 		start - 1 to: stop - 1 do: [:i |
+ 			(predicates at: i) = 1 ifTrue: [
+ 				floatValues at: i put: (replacement at: repStart + i - start).
+ 			].
+ 		].
+ 	].
+ 	(vIsFloat not and: [rIsFloat]) ifTrue: [
+ 		values _ interpreterProxy firstIndexableField: valuesOop.
+ 		floatReplacement _  interpreterProxy firstIndexableField: repOop.
+ 		start - 1 to: stop - 1 do: [:i |
+ 			(predicates at: i) = 1 ifTrue: [
+ 				fv _ self cCoerce: (floatReplacement at: repStart + i - start) to: 'unsigned int'.
+ 				self cCode: '' inSmalltalk: [fv _ fv asInteger].
+ 				values at: i put: fv.
+ 			].
+ 		].
+ 	].
+ 	(vIsFloat not and: [rIsFloat not]) ifTrue: [
+ 		values _ interpreterProxy firstIndexableField: valuesOop.
+ 		replacement _  interpreterProxy firstIndexableField: repOop.
+ 		start - 1 to: stop - 1 do: [:i |
+ 			(predicates at: i) = 1 ifTrue: [
+ 				values at: i put: (replacement at: repStart + i - start).
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveRemArrays (in category 'array arithmetic') -----
+ primitiveRemArrays
+ 
+ 	| length resultOop argOop rcvrOop isArgWords isRcvrWords wordsRcvr wordsArg wordsResult floatsArg floatsResult floatsRcvr wordRcvr wordArg wordResult floatArg floatResult floatRcvr |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #wordsArg declareC: 'unsigned int *wordsArg'.
+ 	self var: #wordsResult declareC: 'unsigned int *wordsResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatsArg declareC: 'float *floatsArg'.
+ 	self var: #floatsResult declareC: 'float *floatsResult'.
+ 	self var: #floatResult declareC: 'double floatResult'.
+ 	self var: #wordResult declareC: 'unsigned int wordResult'.
+ 	self var: #floatRcvr declareC: 'double floatRcvr'.
+ 	self var: #floatArg declareC: 'double floatArg'.
+ 	self var: #wordRcvr declareC: 'unsigned int wordRcvr'.
+ 	self var: #wordArg declareC: 'unsigned int wordArg'.
+ 
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackObjectValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: argOop).
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isWords: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: argOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvrOop)).
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgWords _ interpreterProxy is: argOop MemberOf: 'WordArray'.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isArgWords & isRcvrWords ifTrue: [
+ 		(interpreterProxy is: resultOop MemberOf: 'WordArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	] ifFalse: [
+ 		(interpreterProxy is: resultOop MemberOf: 'KedamaFloatArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	].
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgWords ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			wordsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				wordRcvr _ (wordsRcvr at: i).
+ 				wordArg _ (wordsArg at: i).
+ 				wordResult _ wordRcvr \\ wordArg.
+ 				"In this primitive, words are supposed to be unsigned."
+ 				wordsResult at: i put: wordResult.
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				wordRcvr _ wordsRcvr at: i.
+ 				floatArg _ floatsArg at: i.
+ 				floatResult _ wordRcvr / floatArg.
+ 				floatResult _ self cCode: 'floor(floatResult)' inSmalltalk: [floatResult floor].
+ 				floatsResult at: i put: wordRcvr - (floatResult * floatArg).
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgWords ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatRcvr _ floatsRcvr at: i.
+ 				wordArg _ wordsArg at: i.
+ 				floatResult _ floatRcvr / wordArg.
+ 				floatResult _ self cCode: 'floor(floatResult)' inSmalltalk: [floatResult floor].
+ 				floatsResult at: i put: (floatRcvr - (floatResult * wordArg)).
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatRcvr _ floatsRcvr at: i.
+ 				floatArg _ floatsArg at: i.
+ 				floatResult _ floatRcvr / floatArg.
+ 				floatResult _ self cCode: 'floor(floatResult)' inSmalltalk: [floatResult floor].
+ 				floatsResult at: i put: (floatRcvr - (floatResult * floatArg)).
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveRemScalar (in category 'array arithmetic') -----
+ primitiveRemScalar
+ 
+ 	| length resultOop argOop rcvrOop isRcvrWords wordsRcvr wordsResult floatsResult floatsRcvr isArgInt intArg floatArg wordRcvr floatResult floatRcvr |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #intArg declareC: 'int intArg'.
+ 	self var: #wordsResult declareC: 'unsigned int *wordsResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatArg declareC: 'double floatArg'.
+ 	self var: #floatsResult declareC: 'float *floatsResult'.
+ 	self var: #floatResult declareC: 'double floatResult'.
+ 	self var: #wordResult declareC: 'unsigned int wordResult'.
+ 	self var: #floatRcvr declareC: 'double floatRcvr'.
+ 	self var: #floatArg declareC: 'double floatArg'.
+ 	self var: #wordRcvr declareC: 'unsigned int wordRcvr'.
+ 	self var: #wordArg declareC: 'unsigned int wordArg'.
+ 
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isWords: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: rcvrOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgInt _ interpreterProxy isIntegerObject: argOop.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isArgInt & isRcvrWords ifTrue: [
+ 		(interpreterProxy is: resultOop MemberOf: 'WordArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	] ifFalse: [
+ 		(interpreterProxy is: resultOop MemberOf: 'KedamaFloatArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	].
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgInt ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			wordsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				wordsResult at: i put: (wordsRcvr at: i) \\ intArg.
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				wordRcvr _ wordsRcvr at: i.
+ 				floatResult _ wordRcvr / floatArg.
+ 				floatResult _ self cCode: 'floor(floatResult)' inSmalltalk: [floatResult floor].
+ 				floatsResult at: i put: wordRcvr - (floatResult * floatArg).
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgInt ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatRcvr _ floatsRcvr at: i.
+ 				floatResult _ floatRcvr / intArg.
+ 				floatResult _ self cCode: 'floor(floatResult)' inSmalltalk: [floatResult floor].
+ 				floatsResult at: i put: floatRcvr - (floatResult * intArg).
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatRcvr _ floatsRcvr at: i.
+ 				floatResult _ floatRcvr / floatArg.
+ 				floatResult _ self cCode: 'floor(floatResult)' inSmalltalk: [floatResult floor].
+ 				floatsResult at: i put: floatRcvr - (floatResult * floatArg).
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveSubArrays (in category 'array arithmetic') -----
+ primitiveSubArrays
+ 
+ 	| length resultOop argOop rcvrOop isArgWords isRcvrWords wordsRcvr wordsArg wordsResult floatsArg floatsResult floatsRcvr |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #wordsArg declareC: 'unsigned int *wordsArg'.
+ 	self var: #wordsResult declareC: 'unsigned int *wordsResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatsArg declareC: 'float *floatsArg'.
+ 	self var: #floatsResult declareC: 'float *floatsResult'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackObjectValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: argOop).
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isWords: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: argOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: rcvrOop)).
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgWords _ interpreterProxy is: argOop MemberOf: 'WordArray'.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isArgWords & isRcvrWords ifTrue: [
+ 		(interpreterProxy is: resultOop MemberOf: 'WordArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	] ifFalse: [
+ 		(interpreterProxy is: resultOop MemberOf: 'KedamaFloatArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	].
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgWords ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			wordsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				wordsResult at: i put: (wordsRcvr at: i) - (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (wordsRcvr at: i) - (floatsArg at: i).
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgWords ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			wordsArg _ interpreterProxy firstIndexableField: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (floatsRcvr at: i) - (wordsArg at: i).
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatsArg _ interpreterProxy firstIndexableField: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (floatsRcvr at: i) - (floatsArg at: i).
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>primitiveSubScalar (in category 'array arithmetic') -----
+ primitiveSubScalar
+ 
+ 	| length resultOop argOop rcvrOop isRcvrWords wordsRcvr wordsResult floatsResult floatsRcvr isArgInt intArg floatArg |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: #wordsRcvr declareC: 'unsigned int *wordsRcvr'.
+ 	self var: #intArg declareC: 'int intArg'.
+ 	self var: #wordsResult declareC: 'unsigned int *wordsResult'.
+ 	self var: #floatsRcvr declareC: 'float *floatsRcvr'.
+ 	self var: #floatArg declareC: 'double floatArg'.
+ 	self var: #floatsResult declareC: 'float *floatsResult'.
+ 
+ 	resultOop _ interpreterProxy stackObjectValue: 0.
+ 	argOop _ interpreterProxy stackValue: 1.
+ 	rcvrOop _ interpreterProxy stackObjectValue: 2.
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: rcvrOop).
+ 	interpreterProxy success: (interpreterProxy isWords: resultOop).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 	length _ interpreterProxy stSizeOf: rcvrOop.
+ 	interpreterProxy success: (length = (interpreterProxy stSizeOf: resultOop)).
+ 	interpreterProxy failed ifTrue:[^nil].
+ 
+ 	isArgInt _ interpreterProxy isIntegerObject: argOop.
+ 	isRcvrWords _ interpreterProxy is: rcvrOop MemberOf: 'WordArray'.
+ 
+ 	isArgInt & isRcvrWords ifTrue: [
+ 		(interpreterProxy is: resultOop MemberOf: 'WordArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	] ifFalse: [
+ 		(interpreterProxy is: resultOop MemberOf: 'KedamaFloatArray') ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	].
+ 
+ 	isRcvrWords ifTrue: [
+ 		isArgInt ifTrue: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			wordsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				wordsResult at: i put: (wordsRcvr at: i) - intArg.
+ 			].
+ 		] ifFalse: [
+ 			wordsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (wordsRcvr at: i) - floatArg.
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		isArgInt ifTrue: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			intArg _ interpreterProxy integerValueOf: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (floatsRcvr at: i) - intArg.
+ 			].
+ 		] ifFalse: [
+ 			floatsRcvr _ interpreterProxy firstIndexableField: rcvrOop.
+ 			floatArg _ interpreterProxy floatValueOf: argOop.
+ 			floatsResult _ interpreterProxy firstIndexableField: resultOop.
+ 			0 to: length-1 do:[:i|
+ 				floatsResult at: i put: (floatsRcvr at: i) - floatArg.
+ 			].
+ 		].
+ 	].
+ 
+ 	interpreterProxy pop: 4.
+ 	interpreterProxy push: resultOop.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>radiansToDegrees: (in category 'primitives') -----
+ radiansToDegrees: radians
+ 
+ 	| deg degrees |
+ 	self inline: true.
+ 	self returnTypeC: 'double'.
+ 	self var: 'degrees' declareC: 'double degrees'.
+ 	self var: 'deg' declareC: 'double deg'.
+ 	self var: 'radians' declareC: 'double radians'.
+ 	self var: 'headingRadians' declareC: 'double headingRadians'.
+ 
+ 	degrees _ radians / 0.0174532925199433.
+ 	deg _ 90.0 - degrees.
+ 	deg > 0.0 ifFalse: [deg _ deg + 360.0].
+ 	^ deg.
+ 
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>randomIntoFloatArray (in category 'primitives') -----
+ randomIntoFloatArray
+ 
+ 	| range factor floatArrayOop to from size floatArray |
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'factor' declareC: 'double factor'.
+ 	self var: 'floatArray' declareC: 'float *floatArray'.
+ 
+ 	factor _ interpreterProxy stackFloatValue: 0.
+ 	floatArrayOop _ interpreterProxy stackValue: 1.
+ 	to _ interpreterProxy stackIntegerValue: 2.
+ 	from _ interpreterProxy stackIntegerValue: 3.
+ 	range _ interpreterProxy stackIntegerValue: 4.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isWords: floatArrayOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	size _ interpreterProxy stSizeOf: floatArrayOop.
+ 	(size >= to and: [from >= 1 and: [to >= from]]) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	floatArray _ interpreterProxy firstIndexableField: floatArrayOop.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	from to: to do: [:index |
+ 		floatArray at: index-1 put: (self cCoerce: (self kedamaRandom2: range) to: 'double') * factor.
+ 	].
+ 
+ 	interpreterProxy pop: 5.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>randomIntoIntegerArray (in category 'primitives') -----
+ randomIntoIntegerArray
+ 
+ 	| range factor integerArrayOop to from size integerArray |
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'factor' declareC: 'double factor'.
+ 	self var: 'integerArray' declareC: 'unsigned int *integerArray'.
+ 
+ 	factor _ interpreterProxy stackFloatValue: 0.
+ 	integerArrayOop _ interpreterProxy stackValue: 1.
+ 	to _ interpreterProxy stackIntegerValue: 2.
+ 	from _ interpreterProxy stackIntegerValue: 3.
+ 	range _ interpreterProxy stackIntegerValue: 4.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isWords: integerArrayOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	size _ interpreterProxy stSizeOf: integerArrayOop.
+ 	(size >= to and: [from >= 1 and: [to >= from]]) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	integerArray _ interpreterProxy firstIndexableField: integerArrayOop.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	from to: to do: [:index |
+ 		integerArray at: index-1 put: (self cCoerce: ((self cCoerce: (self kedamaRandom2: range) to: 'double') * factor) to: 'int').
+ 	].
+ 
+ 	interpreterProxy pop: 5.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>randomRange (in category 'primitives') -----
+ randomRange
+ 
+ 	| range ret |
+ 	self export: true.
+ 	self inline: true.
+ 	range _ interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	ret _ self kedamaRandom2: range.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	interpreterProxy pop: 2.
+ 	interpreterProxy pushInteger: ret.
+ 	^ self.
+ 
+ 	!

Item was added:
+ ----- Method: KedamaPlugin2>>scalarGetAngleTo (in category 'primitives') -----
+ scalarGetAngleTo
+ 
+ 	| fromY fromX toY toX x y r |
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'toX' declareC: 'double toX'.
+ 	self var: 'toY' declareC: 'double toY'.
+ 	self var: 'fromX' declareC: 'double fromX'.
+ 	self var: 'fromY' declareC: 'double fromY'.
+ 	self var: 'x' declareC: 'double x'.
+ 	self var: 'y' declareC: 'double y'.
+ 	self var: 'r' declareC: 'double r'.
+ 
+ 	fromY _ interpreterProxy stackFloatValue: 0.
+ 	fromX _ interpreterProxy stackFloatValue: 1.
+ 	toY _ interpreterProxy stackFloatValue: 2.
+ 	toX _ interpreterProxy stackFloatValue: 3.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	x _ toX - fromX.
+ 	y _ toY - fromY.
+ 
+ 	r _ self degreesFromX: x y: y.
+ 	r _ r + 90.0.
+ 	r > 360.0 ifTrue: [r _ r - 360.0].
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 5.
+ 	interpreterProxy pushFloat: r.
+ 
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>scalarGetDistanceTo (in category 'primitives') -----
+ scalarGetDistanceTo
+ 
+ 	| fromY fromX toY toX x y r |
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'toX' declareC: 'double toX'.
+ 	self var: 'toY' declareC: 'double toY'.
+ 	self var: 'fromX' declareC: 'double fromX'.
+ 	self var: 'fromY' declareC: 'double fromY'.
+ 	self var: 'x' declareC: 'double x'.
+ 	self var: 'y' declareC: 'double y'.
+ 	self var: 'r' declareC: 'double r'.
+ 
+ 	fromY _ interpreterProxy stackFloatValue: 0.
+ 	fromX _ interpreterProxy stackFloatValue: 1.
+ 	toY _ interpreterProxy stackFloatValue: 2.
+ 	toX _ interpreterProxy stackFloatValue: 3.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	x _ fromX - toX.
+ 	y _ fromY - toY.
+ 
+ 	r _ ((x * x) + (y * y)) sqrt.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 5.
+ 	interpreterProxy pushFloat: r.
+ 
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>scalarXAt:xArray:headingArray:value:destWidth:leftEdgeMode:rightEdgeMode: (in category 'primitives') -----
+ scalarXAt: index xArray: xArray headingArray: headingArray value: val destWidth: destWidth leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode
+ 
+ 	| newX headingRadians |
+ 	self inline: true.
+ 
+ 	self var: 'xArray' declareC: 'float* xArray'.
+ 	self var: 'headingArray' declareC: 'float* headingArray'.
+ 	self var: 'destWidth' declareC: 'double destWidth'.
+ 	self var: 'val' declareC: 'double val'.
+ 	self var: 'newX' declareC: 'double newX'.
+ 	self var: 'headingRadians' declareC: 'double headingRadians'.
+ 
+ 	newX _ val.
+ 	newX < 0.0 ifTrue: [
+ 		leftEdgeMode = 1 ifTrue: [
+ 			"wrap"
+ 			newX _ newX + destWidth.
+ 		].
+ 		leftEdgeMode = 2 ifTrue: [
+ 			"stick"
+ 			newX _ 0.0.
+ 		].
+ 		leftEdgeMode = 3 ifTrue: [
+ 			"bounce"
+ 			newX _ 0.0 - newX.
+ 			headingRadians _ headingArray at: index.
+ 			headingRadians <  3.141592653589793
+ 				ifTrue: [headingArray at: index put: 3.141592653589793 - headingRadians]
+ 				ifFalse: [headingArray at: index put: 9.42477796076938 - headingRadians].
+ 		].
+ 	].
+ 
+ 	newX >= destWidth ifTrue: [
+ 		rightEdgeMode = 1 ifTrue: [
+ 			newX _ newX - destWidth.
+ 		].
+ 		rightEdgeMode = 2 ifTrue: [
+ 			newX _ destWidth - 0.000001.
+ 		].
+ 		rightEdgeMode = 3 ifTrue: [
+ 			newX _ (destWidth - 0.000001) - (newX - destWidth).
+ 			headingRadians _ headingArray at: index.
+ 			headingRadians < 3.141592653589793
+ 				ifTrue: [headingArray at: index put: (3.141592653589793 - headingRadians)]
+ 				ifFalse: [headingArray at: index put: (9.42477796076938 - headingRadians)].
+ 		]
+ 	].
+ 	xArray at: index put: newX.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>scalarYAt:yArray:headingArray:value:destHeight:topEdgeMode:bottomEdgeMode: (in category 'primitives') -----
+ scalarYAt: index yArray: yArray headingArray: headingArray value: val destHeight: destHeight topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode
+ 
+ 	| newY |
+ 	self inline: true.
+ 
+ 	self var: 'yArray' declareC: 'float* yArray'.
+ 	self var: 'headingArray' declareC: 'float* headingArray'.
+ 	self var: 'destHeight' declareC: 'double destHeight'.
+ 	self var: 'val' declareC: 'double val'.
+ 	self var: 'newY' declareC: 'double newY'.
+ 
+ 	newY _ val.
+ 	newY < 0.0 ifTrue: [
+ 		topEdgeMode = 1 ifTrue: [
+ 			"wrap"
+ 			newY _ newY + destHeight.
+ 		].
+ 		topEdgeMode = 2 ifTrue: [
+ 			"stick"
+ 			newY _ 0.0.
+ 		].
+ 		topEdgeMode = 3 ifTrue: [
+ 			"bounce"
+ 			newY _ 0.0 - newY.
+ 			headingArray at: index put: (6.283185307179586 - (headingArray at: index)).
+ 		].
+ 	].
+ 
+ 	newY >= destHeight ifTrue: [
+ 		bottomEdgeMode = 1 ifTrue: [
+ 			newY _ newY - destHeight.
+ 		].
+ 		bottomEdgeMode = 2 ifTrue: [
+ 			newY _ destHeight - 0.000001.
+ 		].
+ 		bottomEdgeMode = 3 ifTrue: [
+ 			newY _ (destHeight - 0.000001) - (newY - destHeight).
+ 			headingArray at: index put: (6.283185307179586 - (headingArray at: index)).
+ 		]
+ 	].
+ 	yArray at: index put: newY.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>setHeadingArrayFrom (in category 'primitives') -----
+ setHeadingArrayFrom
+ 
+ 	| resultOop headingOop size headingArray resultArray heading isValVector pOop pArray |
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'pArray' declareC: 'unsigned char *pArray'.
+ 	self var: 'headingArray' declareC: 'float *headingArray'.
+ 	self var: 'resultArray' declareC: 'float *resultArray'.
+ 	self var: 'heading' declareC: 'double heading'.
+ 
+ 	resultOop _ interpreterProxy stackValue: 0.
+ 	headingOop _ interpreterProxy stackValue: 1.
+ 	pOop _ interpreterProxy stackValue: 2.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isBytes: pOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: headingOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	size _ interpreterProxy slotSizeOf: headingOop.
+ 	(interpreterProxy isFloatObject: resultOop) ifTrue: [
+ 		isValVector _ false.
+ 	] ifFalse: [
+ 		(interpreterProxy isWords: resultOop) ifTrue: [
+ 			(interpreterProxy slotSizeOf: resultOop) ~= size
+ 				ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 			isValVector _ true
+ 		] ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	].
+ 
+ 	pArray _ interpreterProxy firstIndexableField: pOop.
+ 	headingArray _ interpreterProxy firstIndexableField: headingOop.
+ 	isValVector ifTrue: [
+ 		resultArray _ interpreterProxy firstIndexableField: resultOop.
+ 	] ifFalse: [
+ 		heading _ interpreterProxy floatValueOf: resultOop.
+ 		heading _ self degreesToRadians: heading.
+ 	].
+ 
+ 	0 to: size - 1 do: [:i |
+ 		(pArray at: i) = 1 ifTrue: [
+ 			isValVector ifTrue: [
+ 				heading _ resultArray at: i.
+ 				heading _ self degreesToRadians: heading.
+ 			].
+ 			headingArray at: i put: heading.
+ 		].
+ 	].
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 3.
+ 
+ 	!

Item was added:
+ ----- Method: KedamaPlugin2>>setScalarHeading (in category 'primitives') -----
+ setScalarHeading
+ 
+ 	| headingOop headingArray heading index |
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'headingArray' declareC: 'float *headingArray'.
+ 	self var: 'heading' declareC: 'double heading'.
+ 
+ 	heading _ interpreterProxy stackFloatValue: 0.
+ 	headingOop _ interpreterProxy stackValue: 1.
+ 	index _ interpreterProxy stackIntegerValue: 2.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isWords: headingOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	(interpreterProxy slotSizeOf: headingOop) < index ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	headingArray _ interpreterProxy firstIndexableField: headingOop.
+ 
+ 	headingArray at: index - 1 put: (self degreesToRadians: heading).
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 3.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>shutdownModule (in category 'primitives') -----
+ shutdownModule
+ 
+ 	self export: true.
+ 	^ true.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>turtleScalarSetX (in category 'primitives') -----
+ turtleScalarSetX
+ 
+ 	| xArray headingArray val destWidth xOop headingOop leftEdgeMode rightEdgeMode xIndex size |
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'xArray' declareC: 'float *xArray'.
+ 	self var: 'headingArray' declareC: 'float *headingArray'.
+ 	self var: 'val' declareC: 'double val'.
+ 	self var: 'destWidth' declareC: 'double destWidth'.
+ 
+ 	rightEdgeMode _ interpreterProxy stackIntegerValue: 0.
+ 	leftEdgeMode _ interpreterProxy stackIntegerValue: 1.
+ 	destWidth _ interpreterProxy stackFloatValue: 2.
+ 	val _ interpreterProxy stackFloatValue: 3.
+ 	headingOop _ interpreterProxy stackValue: 4.
+ 	xIndex _ interpreterProxy stackIntegerValue: 5.
+ 	xOop _ interpreterProxy stackValue: 6.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isWords: xOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: headingOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	size _ interpreterProxy slotSizeOf: xOop.
+ 	(interpreterProxy slotSizeOf: headingOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	xArray _ interpreterProxy firstIndexableField: xOop.
+ 	headingArray _ interpreterProxy firstIndexableField: headingOop.
+ 
+ 	self scalarXAt: xIndex - 1 xArray: xArray headingArray: headingArray value: val destWidth: destWidth leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode.
+ 	
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 7.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>turtleScalarSetY (in category 'primitives') -----
+ turtleScalarSetY
+ 
+ 	| yArray headingArray val destHeight yOop headingOop size yIndex topEdgeMode bottomEdgeMode |
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'yArray' declareC: 'float *yArray'.
+ 	self var: 'headingArray' declareC: 'float *headingArray'.
+ 	self var: 'val' declareC: 'double val'.
+ 	self var: 'destHeight' declareC: 'double destHeight'.
+ 
+ 	bottomEdgeMode _ interpreterProxy stackIntegerValue: 0.
+ 	topEdgeMode _ interpreterProxy stackIntegerValue: 1.
+ 	destHeight _ interpreterProxy stackFloatValue: 2.
+ 	val _ interpreterProxy stackFloatValue: 3.
+ 	headingOop _ interpreterProxy stackValue: 4.
+ 	yIndex _ interpreterProxy stackIntegerValue: 5.
+ 	yOop _ interpreterProxy stackValue: 6.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isWords: yOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: headingOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	size _ interpreterProxy slotSizeOf: yOop.
+ 	(interpreterProxy slotSizeOf: headingOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	yArray _ interpreterProxy firstIndexableField: yOop.
+ 	headingArray _ interpreterProxy firstIndexableField: headingOop.
+ 
+ 	self scalarYAt: yIndex - 1 yArray: yArray headingArray: headingArray value: val destHeight: destHeight topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 7.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>turtlesSetX (in category 'primitives') -----
+ turtlesSetX
+ 
+ 	| xArray headingArray valArray val destWidth xOop headingOop valOop leftEdgeMode rightEdgeMode isValVector size newX pOop pArray isWordVector wordValArray |
+ 	self export: true.
+ 	self inline: true.
+ 	
+ 	self var: 'pArray' declareC: 'unsigned char *pArray'.
+ 	self var: 'xArray' declareC: 'float *xArray'.
+ 	self var: 'headingArray' declareC: 'float *headingArray'.
+ 	self var: 'valArray' declareC: 'float *valArray'.
+ 	self var: 'wordValArray' declareC: 'unsigned int *wordValArray'.
+ 	self var: 'val' declareC: 'double val'.
+ 	self var: 'destWidth' declareC: 'double destWidth'.
+ 	self var: 'newX' declareC: 'double newX'.
+ 
+ 	rightEdgeMode _ interpreterProxy stackIntegerValue: 0.
+ 	leftEdgeMode _ interpreterProxy stackIntegerValue: 1.
+ 	destWidth _ interpreterProxy stackFloatValue: 2.
+ 	valOop _ interpreterProxy stackValue: 3.
+ 	headingOop _ interpreterProxy stackValue: 4.
+ 	xOop _ interpreterProxy stackValue: 5.
+ 	pOop _ interpreterProxy stackValue: 6.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isBytes: pOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: xOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: headingOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isFloatObject: valOop) ifTrue: [
+ 		isValVector _ false
+ 	] ifFalse: [
+ 		(interpreterProxy isWords: valOop) ifTrue: [
+ 			isValVector _ true.
+ 			isWordVector _ interpreterProxy is: valOop MemberOf: 'WordArray'.
+ 		] ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	].
+ 
+ 	size _ interpreterProxy slotSizeOf: xOop.
+ 	(interpreterProxy slotSizeOf: pOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy slotSizeOf: headingOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	isValVector ifTrue: [
+ 		(interpreterProxy slotSizeOf: valOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	].
+ 
+ 	pArray _ interpreterProxy firstIndexableField: pOop.
+ 	xArray _ interpreterProxy firstIndexableField: xOop.
+ 	headingArray _ interpreterProxy firstIndexableField: headingOop.
+ 	isValVector ifTrue: [
+ 		isWordVector ifTrue: [
+ 			wordValArray _ interpreterProxy firstIndexableField: valOop.
+ 		] ifFalse: [
+ 			valArray _ interpreterProxy firstIndexableField: valOop.
+ 		].
+ 	] ifFalse: [
+ 		val _ interpreterProxy floatValueOf: valOop
+ 	].
+ 
+ 	0 to: size - 1 do: [:i |
+ 		(pArray at: i) = 1 ifTrue: [
+ 			isValVector ifTrue: [
+ 				isWordVector ifTrue: [
+ 					newX _ wordValArray at: i.
+ 					self cCode: '' inSmalltalk: [newX _ newX asFloat].
+ 				] ifFalse: [
+ 					newX _ valArray at: i.
+ 				].
+ 			] ifFalse: [
+ 				newX _ val.
+ 			].
+ 			self scalarXAt: i xArray: xArray headingArray: headingArray value: newX destWidth: destWidth leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode.
+ 		].
+ 	].
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 7.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>turtlesSetY (in category 'primitives') -----
+ turtlesSetY
+ 
+ 	| yArray headingArray valArray val destHeight yOop headingOop valOop topEdgeMode bottomEdgeMode isValVector size newY pOop pArray isWordVector wordValArray |
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'pArray' declareC: 'unsigned char *pArray'.
+ 	self var: 'yArray' declareC: 'float *yArray'.
+ 	self var: 'headingArray' declareC: 'float *headingArray'.
+ 	self var: 'valArray' declareC: 'float *valArray'.
+ 	self var: 'wordValArray' declareC: 'unsigned int *wordValArray'.
+ 	self var: 'val' declareC: 'double val'.
+ 	self var: 'destHeight' declareC: 'double destHeight'.
+ 	self var: 'newY' declareC: 'double newY'.
+ 
+ 	bottomEdgeMode _ interpreterProxy stackIntegerValue: 0.
+ 	topEdgeMode _ interpreterProxy stackIntegerValue: 1.
+ 	destHeight _ interpreterProxy stackFloatValue: 2.
+ 	valOop _ interpreterProxy stackValue: 3.
+ 	headingOop _ interpreterProxy stackValue: 4.
+ 	yOop _ interpreterProxy stackValue: 5.
+ 	pOop _ interpreterProxy stackValue: 6.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isBytes: pOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: yOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: headingOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isFloatObject: valOop) ifTrue: [
+ 		isValVector _ false
+ 	] ifFalse: [
+ 		(interpreterProxy isWords: valOop) ifTrue: [
+ 			isValVector _ true.
+ 			isWordVector _ interpreterProxy is: valOop MemberOf: 'WordArray'.
+ 		] ifFalse: [
+ 			interpreterProxy primitiveFail. ^ nil
+ 		].
+ 	].
+ 
+ 	size _ interpreterProxy slotSizeOf: yOop.
+ 	(interpreterProxy slotSizeOf: pOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy slotSizeOf: headingOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	isValVector ifTrue: [
+ 		(interpreterProxy slotSizeOf: valOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	].
+ 
+ 	pArray _ interpreterProxy firstIndexableField: pOop.
+ 	yArray _ interpreterProxy firstIndexableField: yOop.
+ 	headingArray _ interpreterProxy firstIndexableField: headingOop.
+ 	isValVector ifTrue: [
+ 		isWordVector ifTrue: [
+ 			wordValArray _ interpreterProxy firstIndexableField: valOop.
+ 		] ifFalse: [
+ 			valArray _ interpreterProxy firstIndexableField: valOop.
+ 		].
+ 	] ifFalse: [
+ 		val _ interpreterProxy floatValueOf: valOop
+ 	].
+ 
+ 	0 to: size - 1 do: [:i |
+ 		(pArray at: i) = 1 ifTrue: [
+ 			isValVector ifTrue: [
+ 				isWordVector ifTrue: [
+ 					newY _ wordValArray at: i.
+ 					self cCode: '' inSmalltalk: [newY _ newY asFloat].
+ 				] ifFalse: [
+ 					newY _ valArray at: i.
+ 				].
+ 			] ifFalse: [
+ 				newY _ val.
+ 			].
+ 			self scalarYAt: i yArray: yArray headingArray: headingArray value: newY destHeight: destHeight topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode.
+ 		].
+ 	].
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 7.
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>vectorGetAngleTo (in category 'primitives') -----
+ vectorGetAngleTo
+ 
+ 	| x y resultOop yArrayOop xArrayOop pYOop pXOop size isVector result xArray yArray pX pY ppx ppy r |
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'x' declareC: 'double x'.
+ 	self var: 'y' declareC: 'double y'.
+ 	self var: 'result' declareC: 'float *result'.
+ 	self var: 'xArray' declareC: 'float *xArray'.
+ 	self var: 'yArray' declareC: 'float *yArray'.
+ 	self var: 'pX' declareC: 'float *pX'.
+ 	self var: 'pY' declareC: 'float *pY'.
+ 	self var: 'ppx' declareC: 'double ppx'.
+ 	self var: 'ppy' declareC: 'double ppy'.
+ 
+ 	resultOop _ interpreterProxy stackValue: 0.
+ 	yArrayOop _ interpreterProxy stackValue: 1.
+ 	xArrayOop _ interpreterProxy stackValue: 2.
+ 	pYOop _ interpreterProxy stackValue: 3.
+ 	pXOop _ interpreterProxy stackValue: 4.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isWords: resultOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: xArrayOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: yArrayOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	size _ interpreterProxy stSizeOf: resultOop.
+ 	size < 0 ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy stSizeOf: xArrayOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy stSizeOf: yArrayOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	(interpreterProxy isFloatObject: pXOop) ifTrue: [
+ 		(interpreterProxy isFloatObject: pYOop)
+ 			ifTrue: [isVector _ false]
+ 			ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	] ifFalse: [
+ 		(interpreterProxy isFloatObject: pYOop)
+ 			ifFalse: [isVector _ true]
+ 			ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	].
+ 
+ 	isVector ifTrue: [
+ 		(interpreterProxy stSizeOf: pXOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 		(interpreterProxy stSizeOf: pYOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	].
+ 
+ 	result _ interpreterProxy firstIndexableField: resultOop.
+ 	xArray _ interpreterProxy firstIndexableField: xArrayOop.
+ 	yArray _ interpreterProxy firstIndexableField: yArrayOop.
+ 	isVector ifTrue: [
+ 		pX _ interpreterProxy firstIndexableField: pXOop.
+ 		pY _ interpreterProxy firstIndexableField: pYOop.
+ 	].
+ 
+ 	isVector ifFalse: [
+ 		ppx _ interpreterProxy floatValueOf: pXOop.
+ 		ppy _ interpreterProxy floatValueOf: pYOop.
+ 	].
+ 
+ 	0 to: size - 1 do: [:index |
+ 		isVector ifTrue: [
+ 			ppx _ pX at: index.
+ 			ppy _ pY at: index.
+ 		].
+ 
+ 		x _ ppx - (xArray at: index).
+ 		y _ ppy - (yArray at: index).
+ 		r _ self degreesFromX: x y: y.
+ 		r _ r + 90.0.
+ 		r > 360.0 ifTrue: [r _ r - 360.0].
+ 
+ 		result at: index put: r.
+ 	].
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 6.
+ 	interpreterProxy push: resultOop.
+ 
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>vectorGetDistanceTo (in category 'primitives') -----
+ vectorGetDistanceTo
+ 
+ 	| x y resultOop yArrayOop xArrayOop pYOop pXOop size isVector result xArray yArray pX pY ppx ppy |
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'x' declareC: 'double x'.
+ 	self var: 'y' declareC: 'double y'.
+ 	self var: 'result' declareC: 'float *result'.
+ 	self var: 'xArray' declareC: 'float *xArray'.
+ 	self var: 'yArray' declareC: 'float *yArray'.
+ 	self var: 'pX' declareC: 'float *pX'.
+ 	self var: 'pY' declareC: 'float *pY'.
+ 	self var: 'ppx' declareC: 'double ppx'.
+ 	self var: 'ppy' declareC: 'double ppy'.
+ 
+ 	resultOop _ interpreterProxy stackValue: 0.
+ 	yArrayOop _ interpreterProxy stackValue: 1.
+ 	xArrayOop _ interpreterProxy stackValue: 2.
+ 	pYOop _ interpreterProxy stackValue: 3.
+ 	pXOop _ interpreterProxy stackValue: 4.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	(interpreterProxy isWords: resultOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: xArrayOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy isWords: yArrayOop) ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	size _ interpreterProxy stSizeOf: resultOop.
+ 	size < 0 ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy stSizeOf: xArrayOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	(interpreterProxy stSizeOf: yArrayOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	(interpreterProxy isFloatObject: pXOop) ifTrue: [
+ 		(interpreterProxy isFloatObject: pYOop)
+ 			ifTrue: [isVector _ false]
+ 			ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	] ifFalse: [
+ 		(interpreterProxy isFloatObject: pYOop)
+ 			ifFalse: [isVector _ true]
+ 			ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	].
+ 
+ 	isVector ifTrue: [
+ 		(interpreterProxy stSizeOf: pXOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 		(interpreterProxy stSizeOf: pYOop) ~= size ifTrue: [interpreterProxy primitiveFail. ^ nil].
+ 	].
+ 
+ 	result _ interpreterProxy firstIndexableField: resultOop.
+ 	xArray _ interpreterProxy firstIndexableField: xArrayOop.
+ 	yArray _ interpreterProxy firstIndexableField: yArrayOop.
+ 	isVector ifTrue: [
+ 		pX _ interpreterProxy firstIndexableField: pXOop.
+ 		pY _ interpreterProxy firstIndexableField: pYOop.
+ 	].
+ 
+ 	isVector ifFalse: [
+ 		ppx _ interpreterProxy floatValueOf: pXOop.
+ 		ppy _ interpreterProxy floatValueOf: pYOop.
+ 	].
+ 
+ 	0 to: size - 1 do: [:index |
+ 		isVector ifTrue: [
+ 			ppx _ pX at: index.
+ 			ppy _ pY at: index.
+ 		].
+ 
+ 		x _ ppx - (xArray at: index).
+ 		y _ ppy - (yArray at: index).
+ 		result at: index put: ((x * x) + (y * y)) sqrt.
+ 	].
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 	interpreterProxy pop: 6.
+ 	interpreterProxy push: resultOop.
+ 
+ !

Item was added:
+ ----- Method: KedamaPlugin2>>zoomBitmap (in category 'primitives') -----
+ zoomBitmap
+ 
+ 	| yFactor xFactor sHeight sWidth dst src srcSize dstSize sOrigin dOrigin srcIndex bit dstIndex srcOrigin |
+ 
+ 	self export: true.
+ 	self inline: true.
+ 	self var: 'sOrigin' declareC: 'unsigned int* sOrigin'.
+ 	self var: 'dOrigin' declareC: 'unsigned int* dOrigin'.
+ 
+ 	yFactor _ interpreterProxy stackIntegerValue: 0.
+ 	xFactor _ interpreterProxy stackIntegerValue: 1.
+ 	sHeight _ interpreterProxy stackIntegerValue: 2.
+ 	sWidth _ interpreterProxy stackIntegerValue: 3.
+ 	dst _ interpreterProxy stackValue: 4.
+ 	src _ interpreterProxy stackValue: 5.
+ 
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	srcSize _ interpreterProxy slotSizeOf: src.
+ 	dstSize _ interpreterProxy slotSizeOf: dst.
+ 
+ 	(sWidth * sHeight) = srcSize ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 	(srcSize * xFactor * yFactor) = dstSize ifFalse: [interpreterProxy primitiveFail. ^ nil].
+ 
+ 	sOrigin _ interpreterProxy firstIndexableField: src.
+ 	dOrigin _ interpreterProxy firstIndexableField: dst.
+ 
+ 	srcIndex _ 0.
+ 	srcOrigin _ 0.
+ 	dstIndex _ 0.
+ 	0 to: sHeight - 1 do: [:sy |
+ 		0 to: yFactor - 1 do: [:y |
+ 			0 to: sWidth - 1 do: [:sx |
+ 				bit _ sOrigin at: srcIndex.
+ 				srcIndex _ srcIndex + 1.
+ 				0 to: xFactor - 1 do: [:dummy |
+ 					dOrigin at: dstIndex put: bit.
+ 					dstIndex _ dstIndex + 1.
+ 				].
+ 			].
+ 			srcIndex _ srcOrigin.
+ 		].
+ 		srcOrigin _ srcOrigin + sWidth.
+ 		srcIndex _ srcOrigin.
+ 	].
+ 
+ 	interpreterProxy pop: 6.
+ !

Item was added:
+ ----- Method: KedamaSequenceExecutionStub class>>isSystemDefined (in category 'as yet unclassified') -----
+ isSystemDefined
+ 	^ name endsWithDigit not!

Item was added:
+ ----- Method: KedamaSequenceExecutionStub class>>isUniClass (in category 'as yet unclassified') -----
+ isUniClass
+ 
+ 	^ self ~~ self officialClass!

Item was added:
+ ----- Method: KedamaSequenceExecutionStub class>>officialClass (in category 'as yet unclassified') -----
+ officialClass
+ 
+ 	^ KedamaSequenceExecutionStub
+ !

Item was added:
+ ----- Method: KedamaSequenceExecutionStub class>>primForwardAt:xArray:yArray:headingArray:value:destWidth:destHeight:leftEdgeMode:rightEdgeMode:topEdgeMode:bottomEdgeMode: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ primForwardAt: i xArray: xArray yArray: yArray headingArray: headingArray value: value destWidth: destWidth destHeight: destHeight leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode
+ 
+ 	| dist newX newY |
+ 	<primitive: 'primScalarForward' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #primScalarForward."
+ 
+ 	dist _ value.
+ 	newX _ (xArray at: i) + (dist asFloat * (headingArray at: i) cos).
+ 	newY _ (yArray at: i) - (dist asFloat * (headingArray at: i) sin).
+ 	KedamaMorph scalarXAt: i xArray: xArray headingArray: headingArray value: newX destWidth: destWidth leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode.
+ 	KedamaMorph scalarYAt: i yArray: yArray headingArray: headingArray value: newY destHeight: destHeight topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode.
+ !

Item was added:
+ ----- Method: KedamaSequenceExecutionStub class>>primGetAngleToX:toY:fromX:fromY: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ primGetAngleToX: toX toY: toY fromX: fromX fromY: fromY
+ 
+ 	| ret |
+ 	<primitive: 'scalarGetAngleTo' module:'KedamaPlugin2'>
+ 	ret _ ((toX - fromX)@(toY - fromY)) theta radiansToDegrees + 90.0.
+ 	ret > 360.0 ifTrue: [^ ret - 360.0].
+ 	^ ret.
+ !

Item was added:
+ ----- Method: KedamaSequenceExecutionStub class>>primGetDistanceToX:toY:fromX:fromY: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ primGetDistanceToX: toX toY: toY fromX: fromX fromY: fromY
+ 
+ 	<primitive: 'scalarGetDistanceTo' module:'KedamaPlugin2'>
+ 	^ ((fromX - toX) squared + (fromY - toY)) squared sqrt.
+ !

Item was added:
+ ----- Method: KedamaSequenceExecutionStub class>>primGetHeadingAt:headingArray: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ primGetHeadingAt: i headingArray: headingArray
+ 
+ 	| heading |
+ 	<primitive: 'getScalarHeading' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #getScalarHeading."
+ 
+ 	heading _ headingArray at: i.
+ 	^ heading _ KedamaMorph radiansToDegrees: heading.
+ !

Item was added:
+ ----- Method: KedamaSequenceExecutionStub class>>primSetHeadingAt:headingArray:value: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ primSetHeadingAt: i headingArray: headingArray value: heading
+ 
+ 	| rad |
+ 	<primitive: 'setScalarHeading' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #setScalarHeading."
+ 
+ 	rad _ KedamaMorph degreesToRadians: heading.
+ 	headingArray at: i put: rad.
+ !

Item was added:
+ ----- Method: KedamaSequenceExecutionStub class>>primSetX:xIndex:headingArray:value:destWidth:leftEdgeMode:rightEdgeMode: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ primSetX: xArray xIndex: xIndex headingArray: headingArray value: value destWidth: destWidth leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode
+ 
+ 	<primitive: 'turtleScalarSetX' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #turtleScalarSetX."
+ 	KedamaMorph scalarXAt: xIndex xArray: xArray headingArray: headingArray value: value destWidth: destWidth leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode.
+ !

Item was added:
+ ----- Method: KedamaSequenceExecutionStub class>>primSetY:yIndex:headingArray:value:destHeight:topEdgeMode:bottomEdgeMode: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ primSetY: yArray yIndex: yIndex headingArray: headingArray value: value destHeight: destHeight topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode
+ 
+ 	<primitive: 'turtleScalarSetY' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #turtleScalarSetY."
+ 	KedamaMorph scalarYAt: yIndex yArray: yArray headingArray: headingArray value: value destHeight: destHeight topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode.
+ !

Item was added:
+ ----- Method: KedamaSequenceExecutionStub class>>wantsChangeSetLogging (in category 'as yet unclassified') -----
+ wantsChangeSetLogging
+ 	"Log changes for Player itself, but not for automatically-created subclasses like Player1, Player2, but *do* log it for uniclasses that have been manually renamed."
+ 
+ 	^ (self == KedamaSequenceExecutionStub or:
+ 		[(self name beginsWith: 'KedamaSequenceExecutionStub') not]) or:
+ 			[Preferences universalTiles]!

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>color: (in category 'player commands') -----
  color: cPixel
  
+ 	| i |
+ 	i _ self index.
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
+ 	(turtles arrays at: 5) at: i put: cPixel.
+ 	kedamaWorld drawRequest.
- 	(turtles arrays at: 5) at: self index put: cPixel.
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>colorFromPatch: (in category 'player commands') -----
  colorFromPatch: aPatch
  
  	| i |
+ 	i _ self index.
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
- 	i := self index.
  	(turtles arrays at: 5) at: i put: ((aPatch costume renderedMorph pixelAtX: ((turtles arrays at: 2) at: i) y: ((turtles arrays at: 3) at: i)) bitAnd: 16rFFFFFF).
+ 	kedamaWorld drawRequest.
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>colorToPatch: (in category 'player commands') -----
  colorToPatch: aPatch
  
  	| i |
+ 	i _ self index.
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
- 	i := self index.
  	aPatch costume renderedMorph pixelAtX: ((turtles arrays at: 2) at: i) y: ((turtles arrays at: 3) at: i) put: ((turtles arrays at: 5) at: i).
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>compileAllAccessors (in category 'method management') -----
  compileAllAccessors
  
+ 	turtles info keys asArray do: [:k |
+ 		(#(who x y heading color visible normal predicate) includes: k) ifFalse: [
- 	turtles info keys do: [:k |
- 		(#(who x y heading color visible normal) includes: k) ifFalse: [
  			self compileScalarInstVarAccessorsFor: k.
  		].
  	].
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>compileScalarInstVarAccessorsFor: (in category 'method management') -----
  compileScalarInstVarAccessorsFor: varName
  
  	| nameString type setPhrase arrayIndex getPhrase |
+ 	nameString _ varName asString capitalized.
+ 	arrayIndex _ turtles info at: varName asSymbol.
- 	nameString := varName asString capitalized.
- 	arrayIndex := turtles info at: varName asSymbol.
  
+ 	type _ turtles types at: arrayIndex.
- 	type := turtles types at: arrayIndex.
  	type = #Number ifTrue: [
+ 		setPhrase _ 'setNumberVarAt:'.
+ 		getPhrase _ 'getNumberVarOf:'.
- 		setPhrase := 'setNumberVarAt:'.
- 		getPhrase := 'getNumberVarOf:'.
  	].
  	type = #Boolean ifTrue: [
+ 		setPhrase _ 'setBooleanVarAt:'.
+ 		getPhrase _ 'getBooleanVarOf:'
- 		setPhrase := 'setBooleanVarAt:'.
- 		getPhrase := 'getBooleanVarOf:'
  	].
  	type = #Color ifTrue: [
+ 		setPhrase _ 'setColorVarAt:'.
+ 		getPhrase _ 'getColorVarOf:'
- 		setPhrase := 'setColorVarAt:'.
- 		getPhrase := 'getColorVarOf:'
  	].
+ 	setPhrase ifNil: [setPhrase _ 'setObjectVarAt:'].
+ 	getPhrase ifNil: [getPhrase _ 'getObjectVarOf:'].
- 	setPhrase ifNil: [setPhrase := 'setObjectVarAt:'].
- 	getPhrase ifNil: [getPhrase := 'getObjectVarOf:'].
  
+ 	self class compileSilently: ('get{1}
+ 	^ self {2} ((turtles arrays at: {3}) at: self index)' format: {nameString. getPhrase. arrayIndex printString})
+ "'get', nameString, '
+ 	^ self ', getPhrase, '((turtles arrays at: ', arrayIndex printString, ') at: self index)')"
- 	self class compileSilently: ('get', nameString, '
- 	^ self ', getPhrase, '((turtles arrays at: ', arrayIndex printString, ') at: self index)')
  		classified: 'access'.
  
+ 
+ 	self class compileSilently: ('set{1}: xxxArg
+ 	self {2} {3} at: self index put: xxxArg' format: {nameString. setPhrase. arrayIndex printString}
+ "'set', nameString, ': xxxArg
+ 		self ', setPhrase, arrayIndex printString, ' at: self index put: xxxArg'" )
- 	self class compileSilently: ('set', nameString, ': xxxArg
- 		self ', setPhrase, arrayIndex printString, ' at: self index put: xxxArg' )
  		classified: 'access'!

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>delete (in category 'deleting') -----
  delete
  
+ 	| anInstance |
+ 	turtles _ nil.
+ 	exampler _ nil.
- 	arrays := nil.
- 	exampler := nil.
  	self class removeFromSystem: false.
+ 	anInstance := UnscriptedPlayer new.
+ 	self become: anInstance.
- 	self becomeForward: UnscriptedPlayer new
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>die (in category 'player commands') -----
  die
  
+ 	| i |
+ 	i _ self index.
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
  	kedamaWorld deleteTurtleID: self getWho of: exampler.
+ 	kedamaWorld drawRequest.
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>doDieCommand: (in category 'command execution') -----
  doDieCommand: aBlock
  
  	| ret |
+ 	ret _ self doExamplerCommand: aBlock.
+ 	"sequentialStub index: self index."
+ 	aBlock value: self.
- 	ret := self doExamplerCommand: aBlock.
- 	sequentialStub index: index.
- 	aBlock value: sequentialStub.
  
  	^ ret.
  
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>forward: (in category 'player commands') -----
  forward: v
  
+ 	| i |
+ 	i _ self index.
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
+ 	KedamaSequenceExecutionStub primForwardAt: i xArray: (turtles arrays at: 2) yArray: (turtles arrays at: 3) headingArray: (turtles arrays at: 4) value: v asFloat destWidth: kedamaWorld wrapX destHeight: kedamaWorld wrapY leftEdgeMode: kedamaWorld leftEdgeModeMnemonic rightEdgeMode: kedamaWorld rightEdgeModeMnemonic topEdgeMode: kedamaWorld topEdgeModeMnemonic bottomEdgeMode: kedamaWorld bottomEdgeModeMnemonic.
+ 	kedamaWorld drawRequest.
- 	^ self primForwardAt: self index xArray: (turtles arrays at: 2) yArray: (turtles arrays at: 3) headingArray: (turtles arrays at: 4) value: v asFloat destWidth: kedamaWorld wrapX destHeight: kedamaWorld wrapY leftEdgeMode: kedamaWorld leftEdgeModeMnemonic rightEdgeMode: kedamaWorld rightEdgeModeMnemonic topEdgeMode: kedamaWorld topEdgeModeMnemonic bottomEdgeMode: kedamaWorld bottomEdgeModeMnemonic.
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>getAngleTo: (in category 'player commands') -----
  getAngleTo: aPlayer
  
  	| i xy |
+ 	i _ self index.
+ 	xy _ aPlayer getXAndY.
+ 	^ KedamaSequenceExecutionStub primGetAngleToX: xy x toY: xy y fromX: ((turtles arrays at: 2) at: i) fromY: ((turtles arrays at: 3) at: i).
- 	i := self index.
- 	xy := aPlayer getXAndY.
- 	^ self primGetAngleToX: xy x toY: xy y fromX: ((turtles arrays at: 2) at: i) fromY: ((turtles arrays at: 3) at: i).
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>getDistanceTo: (in category 'player commands') -----
  getDistanceTo: aPlayer
  
  	| i xy |
+ 	i _ self index.
+ 	xy _ aPlayer getXAndY.
+ 	^ KedamaSequenceExecutionStub primGetDistanceToX: xy x toY: xy y fromX: ((turtles arrays at: 2) at: i) fromY: ((turtles arrays at: 3) at: i).
- 	i := self index.
- 	xy := aPlayer getXAndY.
- 	^ self primGetDistanceToX: xy x toY: xy y fromX: ((turtles arrays at: 2) at: i) fromY: ((turtles arrays at: 3) at: i).
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>getHeading (in category 'player commands') -----
  getHeading
  
+ 	^ KedamaSequenceExecutionStub primGetHeadingAt: self index headingArray: (turtles arrays at: 4).
- 	^ self primGetHeadingAt: self index headingArray: (turtles arrays at: 4).
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>hide (in category 'player commands') -----
  hide
  
  	(turtles arrays at: 6) at: self index put: 0.
+ 	kedamaWorld drawRequest.
  !

Item was added:
+ ----- Method: KedamaSequenceExecutionStub>>kedamaWorld: (in category 'accessing') -----
+ kedamaWorld: k
+ 
+ 	kedamaWorld _ k.
+ !

Item was added:
+ ----- Method: KedamaSequenceExecutionStub>>removeSlotNamed: (in category 'method management') -----
+ removeSlotNamed: aSlotName
+ 
+ 	self class removeSelectorSilently: (Utilities getterSelectorFor: aSlotName).
+ 	self class removeSelectorSilently: (Utilities setterSelectorFor: aSlotName).
+ 	self compileAllAccessors.
+ !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>setBlueComponentIn:to: (in category 'player commands') -----
  setBlueComponentIn: aPatch to: value
  
  	| i pix |
+ 	i _ self index.
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
+ 	pix _ aPatch costume renderedMorph pixelAtX: ((turtles arrays at: 2) at: i) y: ((turtles arrays at: 3) at: i).
+ 	pix _ (pix bitAnd: 16rFFFF00) bitOr: ((value asInteger bitAnd: 16rFF) bitShift: 16).
- 	i := self index.
- 	pix := aPatch costume renderedMorph pixelAtX: ((turtles arrays at: 2) at: i) y: ((turtles arrays at: 3) at: i).
- 	pix := (pix bitAnd: 16rFFFF00) bitOr: ((value asInteger bitAnd: 16rFF) bitShift: 16).
  	aPatch costume renderedMorph pixelAtX: ((turtles arrays at: 2) at: i) y: ((turtles arrays at: 3) at: i) put: pix.
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>setBooleanVarAt:at:put: (in category 'accessing - private') -----
  setBooleanVarAt: arrayIndex at: i put: v
  
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
  	(turtles arrays at: arrayIndex) at: i put: ((v == true or: [v isNumber and: [v ~= 0]]) ifTrue: [1] ifFalse: [0]).
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>setColor: (in category 'player commands') -----
  setColor: aColor
  
+ 	| i |
+ 	i _ self index.
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
+ 	(turtles arrays at: 5) at: i put: ((aColor pixelValueForDepth: 32)).
+ 	kedamaWorld drawRequest.
- 	(turtles arrays at: 5) at: self index put: ((aColor pixelValueForDepth: 32) bitAnd: 16rFFFFFF).
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>setColorVarAt:at:put: (in category 'accessing - private') -----
  setColorVarAt: arrayIndex at: i put: v
  
  	| val |
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
+ 	val _ v isColor ifTrue: [v pixelValueForDepth: 32] ifFalse: [v].
- 	val := v isColor ifTrue: [v pixelValueForDepth: 32] ifFalse: [v].
  	(turtles arrays at: arrayIndex) at: i put: val.
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>setHeading: (in category 'player commands') -----
  setHeading: degrees
  
+ 	| i |
+ 	i _ self index.
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
+ 	^ KedamaSequenceExecutionStub primSetHeadingAt: i headingArray: (turtles arrays at: 4) value: degrees asFloat.
- 	^ self primSetHeadingAt: self index headingArray: (turtles arrays at: 4) value: degrees asFloat.
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>setNumberVarAt:at:put: (in category 'accessing - private') -----
  setNumberVarAt: arrayIndex at: i put: v
  
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
  	(turtles arrays at: arrayIndex) at: i put: v.
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>setObjectVarAt:at:put: (in category 'accessing - private') -----
  setObjectVarAt: arrayIndex at: i put: v
  
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
  	(turtles arrays at: arrayIndex) at: i put: v.
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>setPatchValueIn:to: (in category 'player commands') -----
  setPatchValueIn: aPatch to: value
  
  	| i |
+ 	i _ self index.
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
- 	i := self index.
  	aPatch costume renderedMorph pixelAtX: ((turtles arrays at: 2) at: i) y: ((turtles arrays at: 3) at: i) put: value.
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>setRedComponentIn:to: (in category 'player commands') -----
  setRedComponentIn: aPatch to: value
  
  	| i pix |
+ 	i _ self index.
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
+ 	pix _ aPatch costume renderedMorph pixelAtX: ((turtles arrays at: 2) at: i) y: ((turtles arrays at: 3) at: i).
+ 	pix _ (pix bitAnd: 16rFFFF) bitOr: ((value asInteger bitAnd: 16rFF) bitShift: 16).
- 	i := self index.
- 	pix := aPatch costume renderedMorph pixelAtX: ((turtles arrays at: 2) at: i) y: ((turtles arrays at: 3) at: i).
- 	pix := (pix bitAnd: 16rFFFF) bitOr: ((value asInteger bitAnd: 16rFF) bitShift: 16).
  	aPatch costume renderedMorph pixelAtX: ((turtles arrays at: 2) at: i) y: ((turtles arrays at: 3) at: i) put: pix.
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>setScalarSlotTypeFor:typeChosen: (in category 'player protocol') -----
  setScalarSlotTypeFor: slotName typeChosen: typeChosen
  
+ 	self compileScalarInstVarAccessorsFor: slotName.
- 	self compileAllAccessors.
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>setTurtleCount: (in category 'player protocol') -----
  setTurtleCount: aNumber
  
+ 	| i |
+ 	i _ self index.
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
  	^ exampler setTurtleCount: aNumber.
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>setTurtleVisible: (in category 'player commands') -----
  setTurtleVisible: aBoolean
  
+ 	| i |
+ 	i _ self index.
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
+ 	^ (turtles arrays at: 6) at: i put: (aBoolean ifTrue: [1] ifFalse: [0])
- 	^ (turtles arrays at: 6) at: self index put: (aBoolean ifTrue: [1] ifFalse: [0])
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>setX: (in category 'player commands') -----
  setX: val
  
+ 	| i |
+ 	i _ self index.
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
+ 	kedamaWorld drawRequest.
+ 	^ KedamaSequenceExecutionStub primSetX: (turtles arrays at: 2) xIndex: i headingArray: (turtles arrays at: 4) value: val asFloat destWidth: kedamaWorld wrapX leftEdgeMode: kedamaWorld leftEdgeModeMnemonic rightEdgeMode: kedamaWorld rightEdgeModeMnemonic.
- 	^ self primSetX: (turtles arrays at: 2) xIndex: self index headingArray: (turtles arrays at: 4) value: val asFloat destWidth: kedamaWorld wrapX leftEdgeMode: kedamaWorld leftEdgeModeMnemonic rightEdgeMode: kedamaWorld rightEdgeModeMnemonic.
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>setY: (in category 'player commands') -----
  setY: val
  
+ 	| i |
+ 	i _ self index.
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
+ 	kedamaWorld drawRequest.
+ 	^ KedamaSequenceExecutionStub primSetY: (turtles arrays at: 3) yIndex: i headingArray: (turtles arrays at: 4) value: val asFloat destHeight: kedamaWorld wrapY topEdgeMode: kedamaWorld topEdgeModeMnemonic bottomEdgeMode: kedamaWorld bottomEdgeModeMnemonic.
- 	^ self primSetY: (turtles arrays at: 3) yIndex: self index headingArray: (turtles arrays at: 4) value: val asFloat destHeight: kedamaWorld wrapY topEdgeMode: kedamaWorld topEdgeModeMnemonic bottomEdgeMode: kedamaWorld bottomEdgeModeMnemonic.
  !

Item was changed:
  ----- Method: KedamaSequenceExecutionStub>>show (in category 'player commands') -----
  show
  
+ 	| i |
+ 	i _ self index.
+ 	((turtles arrays at: 7) at: i) = 0 ifTrue: [^ self].
+ 	(turtles arrays at: 6) at: i put: 1.
+ 	kedamaWorld drawRequest.
- 	(turtles arrays at: 6) at: self index put: 1.
  !

Item was added:
+ ----- Method: KedamaSetColorComponentTile>>assignmentRootForParseNode (in category '*Etoys-Squeakland-code generation') -----
+ assignmentRootForParseNode
+ 
+ 	^ assignmentRoot!

Item was added:
+ ----- Method: KedamaSetColorComponentTile>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') -----
+ parseNodeWith: encoder
+ 
+ 	^ patchTile parseNodeWith: encoder.
+ !

Item was added:
+ ----- Method: KedamaSetColorComponentTile>>sexpWith: (in category '*Etoys-Squeakland-code generation') -----
+ sexpWith: aDictionary
+ 
+ 	^ patchTile sexpWith: aDictionary.
+ !

Item was changed:
  ----- Method: KedamaSetColorComponentTile>>storeCodeOn:indent: (in category 'initialization') -----
  storeCodeOn: aStream indent: tabCount 
  	"We have a hidden arg. Output two keywords with interspersed arguments."
  
  	| firstKeyword |
  	(#('redComponentIn:' 'setRedComponentIn:') includes: assignmentRoot) ifTrue: [
+ 		firstKeyword _ 'setRedComponentIn'.
- 		firstKeyword := 'setRedComponentIn'.
  	].
  	(#('greenComponentIn:' 'setGreenComponentIn:') includes: assignmentRoot) ifTrue: [
+ 		firstKeyword _ 'setGreenComponentIn'
- 		firstKeyword := 'setGreenComponentIn'
  	].
  	(#('blueComponentIn:' 'setBlueComponentIn:') includes: assignmentRoot) ifTrue: [
+ 		firstKeyword _ 'setBlueComponentIn'
- 		firstKeyword := 'setBlueComponentIn'
  	].
  
  	aStream nextPutAll: firstKeyword.
  	aStream nextPut: $:.
  			aStream space."Simple assignment, don't need existing value"
  	patchTile submorphs first storeCodeOn: aStream indent: tabCount.
  	aStream nextPutAll: ' to: '.
  
  	assignmentSuffix = ':' 
  		ifFalse: 
  			["Assignments that require that old values be retrieved"
  
  			aStream nextPutAll: '( '.
  			self assignmentReceiverTile storeCodeOn: aStream indent: tabCount.
  			aStream space.
+ 			aStream nextPutAll: 'get', (firstKeyword copyFrom: 4 to: firstKeyword size), ':'.
- 			aStream nextPutAll: 'getPatchValueIn:'.
  			patchTile submorphs first storeCodeOn: aStream indent: tabCount.
  			aStream nextPutAll: ')'.
  			aStream space.
  			aStream nextPutAll: (self operatorForAssignmentSuffix: assignmentSuffix).
  			aStream space]!

Item was added:
+ ----- Method: KedamaSetPixelValueTile>>assignmentRootForParseNode (in category '*Etoys-Squeakland-tile protocol') -----
+ assignmentRootForParseNode
+ 
+ 	^ 'setPatchValueIn:'.
+ !

Item was added:
+ ----- Method: KedamaSetPixelValueTile>>parseNodeWith: (in category '*Etoys-Squeakland-tile protocol') -----
+ parseNodeWith: encoder
+ 
+ 	^ patchTile parseNodeWith: encoder!

Item was added:
+ ----- Method: KedamaSetPixelValueTile>>sexpWith: (in category '*Etoys-Squeakland-tile protocol') -----
+ sexpWith: aDictionary
+ 
+ 	^ patchTile sexpWith: aDictionary.
+ !

Item was added:
+ KedamaAttributeDefnition subclass: #KedamaTurtleMethodAttributionDefinition2
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tweak-Kedama-ParseTree-AttributeDefinition'!

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>addNodeInfoTo:receiverObject:stmtChain:scriptReceiver:messageType:isStatement:isInTest:parentNode: (in category 'rules') -----
+ addNodeInfoTo: dict receiverObject: myReceiverObject stmtChain: myStmtChain scriptReceiver: rec messageType: myMessageType isStatement: myIsStatement isInTest: myIsInTest parentNode: parentNode
+ 
+ 	| n sym var infos testFlag isInAllTest lastTestStmt readOrWrite patchGet |
+ 	infos _ WriteStream on: (Array new: 2).
+ 	testFlag _ #none.
+ 	readOrWrite _ (Player readOrWriteOrNil: self selector key).
+ 	isInAllTest _ myStmtChain inject: false into: [:subTotal :next | subTotal | (next at: 2)].
+ 	(isInAllTest and: [myIsInTest not]) ifTrue: [testFlag _ #testBody].
+ 	myIsInTest ifTrue: [testFlag _ #testCond].
+ 	myIsInTest ifTrue: [
+ 		lastTestStmt _ myStmtChain reverse detect: [:e | e second] ifNone: [self halt].
+ 		(dict at: lastTestStmt first) add: (Array with: myReceiverObject with: self selector with: self receiver with: #read with: testFlag).
+ 		^ dict
+ 	].
+ 
+ 	self receiver isLeaf ifTrue: [
+ 		myReceiverObject isPlayerLike ifTrue: [
+ 			(#(#getPatchValueIn: setPatchValueIn:to:) includes: self selector key) ifTrue: [
+ 				patchGet _ self selector key = #getPatchValueIn:.
+ 				n _ self arguments first.
+ 				n isLeaf ifTrue: [
+ 					sym _ (n key isKindOf: LookupKey) ifTrue: [n key key] ifFalse: [n key].
+ 					var _ Compiler evaluate: sym for: rec notifying: nil logged: false.
+ 					infos nextPut: (Array with: var with: self selector key with: self receiver key with: (patchGet ifTrue: [#read] ifFalse: [#write]) with: testFlag).
+ 					infos nextPut: (Array with: myReceiverObject with: self selector key with: self receiver key with: (patchGet ifTrue: [#write] ifFalse: [#read]) with: testFlag).
+ 				] ifFalse: [
+ 					infos nextPut: (Array with: myReceiverObject with: self selector key with: self receiver key with: #read with: testFlag).
+ 				].
+ 			] ifFalse: [
+ 				infos nextPut: (Array with: myReceiverObject with: self selector key with: self receiver key
+ 					with: readOrWrite with: testFlag).
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		(myIsStatement and: [myMessageType ~~ #condition]) ifTrue: [
+ 			infos nextPut: (Array with: nil with: self selector key with: self receiver
+ 				with: readOrWrite with: testFlag).
+ 		]
+ 	].
+ 
+ 	infos contents do: [:q |
+ 		myStmtChain do: [:stmt |
+ 			(dict at: (stmt at: 1)) addFirst: q
+ 		].
+ 	].
+ 				
+ 	^ dict.!

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>addToStmtChain:isStatement: (in category 'rules') -----
+ addToStmtChain: parentStmtChain isStatement: myIsStatement
+ 
+ 	| isTest |
+ 	isTest _ self messageType value = #condition.
+ 	myIsStatement ifTrue: [
+ 		^ parentStmtChain copyWith: (Array with: self with: isTest).
+ 	].
+ 	^ parentStmtChain
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>assignmentMsgType (in category 'rules') -----
+ assignmentMsgType
+ 
+ 	^ #assignment.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>attributeDefinition (in category 'definition') -----
+ attributeDefinition
+ 
+ 	^ #(
+ 		(ParseNode rvr inh)
+ 		(ParseNode myNode inh)
+ 		(ParseNode blockType inh) "#none, #default, #top, #condition, or #sequential"
+ 		(ParseNode isStatement inh)
+ 		(ParseNode isTopStatement inh)
+ 		(ParseNode messageType synth)
+ 
+ 		(ParseNode receiverObject synth)
+ 
+ 		(ParseNode isInTest inh)
+ 		(ParseNode stmtChain inh)
+ 
+ 		(ParseNode nodeInfoIn inh)
+ 		(ParseNode nodeInfoOut synth)
+ 
+ 		(ParseNode primaryBreedPair inh)
+ 		(ParseNode statementType inh) "#none, #parallel, #sequential, or #die"
+ 		(ParseNode rewriteInfoIn inh)
+ 		(ParseNode rewriteInfoOut synth)
+ 	).
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>blockRewriteInfo:statementType:primaryBreedPair: (in category 'rules') -----
+ blockRewriteInfo: parentRewriteInfo statementType: myStmtType primaryBreedPair: myPrimaryBreedPair
+ 
+ 	(#(parallel sequential die) includes: myStmtType) ifFalse: [^ parentRewriteInfo].
+ 	myPrimaryBreedPair ifNil: [^ parentRewriteInfo].
+ 	^ Array with: myPrimaryBreedPair first with: ('var', myPrimaryBreedPair first identityHash printString, self identityHash printString).
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>blockType:parentMessageType: (in category 'rules') -----
+ blockType: parentType parentMessageType: parentMessageType
+ 
+ 	parentType = #none ifTrue: [^ #top].
+ 	parentMessageType = #condition ifTrue: [^ #condition].
+ 	parentMessageType = #sequential ifTrue: [^ #sequential].
+ 	^ #default.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>defaultBlockType: (in category 'rules') -----
+ defaultBlockType: parentBlockType
+ 
+ 	^ #default.
+ 
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>defaultMessageType (in category 'rules') -----
+ defaultMessageType
+ 
+ 	^ #none.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>determineStatementType:fromDict:primaryBreedPair:messageType:isStatement:receiverObject: (in category 'rules') -----
+ determineStatementType: parentStmtType fromDict: dict primaryBreedPair: myPrimaryBreedPair messageType: myMessageType isStatement: myIsStatement receiverObject: myReceiverObject
+ 
+ 	| vectorTurtle turtleSelectors participants reads writes unknownReceiverSelectors |
+ 		"Do the calculation only at the statement level."
+ 	myIsStatement ifFalse: [^ parentStmtType].
+ 		"If there is a doSequentially: block, the block is sequential."
+ 
+ 	participants _ dict at: self.
+ 	(participants select: [:e | (e first notNil and: [e first isPrototypeTurtlePlayer])]) size = 0 ifTrue: [^ #none].
+ 	myMessageType = #sequential ifTrue: [^ #sequential].
+ 
+ 	parentStmtType = #sequential ifTrue: [^ #sequential].
+ 
+ 	"If there is not turtle involved in the statement, it is not transformed."
+ 	myPrimaryBreedPair ifNil: [^ #none].
+ 
+ 
+ 	vectorTurtle _ myPrimaryBreedPair first.
+ 	myMessageType = #condition ifTrue: [
+ 		reads _ IdentitySet new.
+ 		writes _ IdentitySet new.
+ 	
+ 		participants do: [:list |
+ 			(((list at: 5) = #testBody or: [(list at: 5) = #testCond]) and: [(list at: 4) ~= #read]) ifTrue: [list first ifNotNil: [writes add: list first]].
+ 			(((list at: 5) = #testBody or: [(list at: 5) = #testCond]) and: [(list at: 4) = #read]) ifTrue: [list first ifNotNil: [reads add: list first]].
+ 		].
+ 		((writes
+ 			intersection: reads)
+ 				copyWithout: vectorTurtle) ifNotEmpty: [
+ 					^ #sequential
+ 		].
+ 		^ #parallel.
+ 	].
+ 
+ 	reads _ IdentitySet new.
+ 	writes _ IdentitySet new.
+ 	turtleSelectors _ OrderedCollection new.
+ 	unknownReceiverSelectors _ OrderedCollection new.
+ 	participants do: [:list |
+ 		list first = vectorTurtle ifTrue: [
+ 			((vectorTurtle isBreedSelector: list second) or: [
+ 				(vectorTurtle isUserDefinedSelector: list second)]) ifFalse: [
+ 					turtleSelectors add: list second
+ 			].
+ 		].
+ 		list first
+ 			ifNil: [unknownReceiverSelectors add: list second]
+ 			ifNotNil: [
+ 				((list at: 4) == #read) ifTrue: [reads add: list first].
+ 				((list at: 4) == #read) ifFalse: [writes add: list first].
+ 			].
+ 		(vectorTurtle containsSequentialSelector: list second) ifTrue: [^ #sequential].
+ 	].
+ 	(turtleSelectors includes: #die) ifTrue: [^ #die].
+ 	(((self isKindOf: AssignmentNode) and: [myReceiverObject = vectorTurtle])
+ 		and: [vectorTurtle isBreedSelector: self property property]) ifTrue: [^ #none].
+ 
+ 	(vectorTurtle areOkaySelectors: unknownReceiverSelectors) ifFalse: [
+ 		^ #sequential.
+ 	].
+ 
+ 	(vectorTurtle vectorizableTheseSelectors: turtleSelectors) ifFalse: [^ #sequential].
+ 	((reads intersection: writes) copyWithout: vectorTurtle) ifNotEmpty: [^ #sequential].
+ 	^ #parallel.
+ 
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>firstInReceivers: (in category 'rules') -----
+ firstInReceivers: receivers
+ 
+ 	^ receivers first.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>initialBlockType (in category 'rules') -----
+ initialBlockType
+ 
+ 	^ #none.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>initialDictForBodyParticipants (in category 'rules') -----
+ initialDictForBodyParticipants
+ 
+ 	^ Dictionary new.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>initialDictForNodeInfo (in category 'rules') -----
+ initialDictForNodeInfo
+ 
+ 	^ Dictionary new.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>initialEmptyDict (in category 'rules') -----
+ initialEmptyDict
+ 
+ 	^ Dictionary new.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>initialEmptyList (in category 'rules') -----
+ initialEmptyList
+ 
+ 	^ #().
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>initialEmptyOrderedCollection (in category 'rules') -----
+ initialEmptyOrderedCollection
+ 
+ 	^ OrderedCollection new.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>initialFalse (in category 'rules') -----
+ initialFalse
+ 
+ 	^ false.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>initialNil (in category 'rules') -----
+ initialNil
+ 
+ 	^ nil.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>isStmt: (in category 'rules') -----
+ isStmt: parentBlockType
+ 
+ 	^ parentBlockType = #top or: [parentBlockType = #condition].
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>isTest:parentNode: (in category 'rules') -----
+ isTest: parentIsInTest parentNode: parentNode
+ 
+ 	parentIsInTest = true ifTrue: [^ true].
+ 	^ ((parentNode isMemberOf: MessageNode) and: [parentNode receiver = self and: [ parentNode messageType value = #condition]])
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>isTopStmt: (in category 'rules') -----
+ isTopStmt: parentTopStmt
+ 
+ 	parentTopStmt = nil ifTrue: [^ true].
+ 	^ false.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>isTopStmtForBlock: (in category 'rules') -----
+ isTopStmtForBlock: parentTopStmt
+ 
+ 	parentTopStmt = nil ifTrue: [^ nil].
+ 	^ false.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>msgType (in category 'rules') -----
+ msgType
+ 
+ 	(#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:) includes: self selector key) ifTrue: [
+ 		^ #condition
+ 	].
+ 
+ 	(#(whileTrue: whileFalse:) includes: self selector key) ifTrue: [
+ 		^ #loop
+ 	].
+ 	(#(doSequentially:) includes: self selector key) ifTrue: [
+ 		^ #sequential
+ 	].
+ 	^ #none.
+ 
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>parentRewriteInfo:primaryBreedPair:isStatement:isTopStatement: (in category 'rules') -----
+ parentRewriteInfo: parentRewriteInfo primaryBreedPair: myBreedPair isStatement: myIsStatement isTopStatement: myIsTopStatement
+ 
+ 	myIsTopStatement ifTrue: [
+ 		myBreedPair ifNil: [^ parentRewriteInfo].
+ 		^ myBreedPair.
+ 	].
+ 	myIsStatement ifTrue: [
+ 		myBreedPair ifNil: [^ parentRewriteInfo].
+ 		parentRewriteInfo ifNil: [^ parentRewriteInfo].
+ 		parentRewriteInfo first = myBreedPair first ifFalse: [
+ 			^ myBreedPair.
+ 		].
+ 	].
+ 
+ 	^ parentRewriteInfo
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>primaryBreedPair:fromDict:isStatement: (in category 'rules') -----
+ primaryBreedPair: parentPrimaryBreedPair fromDict: dict isStatement: myIsStatement
+ 
+ 	| turtlesInfo n |
+ 	myIsStatement ifTrue: [
+ 		turtlesInfo _ (dict at: self) select: [:e | e first notNil and: [(e first isPrototypeTurtlePlayer) and: [(e first isBreedSelector: e second) not]]].
+ 		(turtlesInfo collect: [:p | p first]) asSet size = 0 ifTrue: [^ parentPrimaryBreedPair].
+ 		n _ turtlesInfo first third.
+ 		^ Array with: (turtlesInfo first first) with: ((n isKindOf: LookupKey) ifTrue: [n key] ifFalse: [n]).
+ 	].
+ 	^ parentPrimaryBreedPair.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>rcvr (in category 'rules') -----
+ rcvr
+ 
+ 	^ true.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>rcvr: (in category 'rules') -----
+ rcvr: rec
+ 
+ 	^ rec.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>rewriteInfo:statementType:primaryBreedPair:isStatement: (in category 'rules') -----
+ rewriteInfo: parentRewriteInfo statementType: myStatementType primaryBreedPair: myPrimaryBreedPair isStatement: myIsStatement
+ 
+ 	myIsStatement ifTrue: [
+ 		(#(parallel sequential die) includes: myStatementType) ifFalse: [^ nil].
+ 		myPrimaryBreedPair ifNil: [^ nil].
+ 		^ Array with: myPrimaryBreedPair first with: ('var', myPrimaryBreedPair first identityHash printString, self identityHash printString).
+ 	].
+ 	^ parentRewriteInfo.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>rewriteVariable:with:rewriteInfo: (in category 'rules') -----
+ rewriteVariable: recObject with: myPrimaryBreedPair rewriteInfo: myRewriteInfo
+ 
+ 	myPrimaryBreedPair ifNil: [^ nil].
+ 	myPrimaryBreedPair first = recObject ifTrue: [^ myRewriteInfo].
+ 	^ nil.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>semanticRuleSignatures (in category 'definition') -----
+ semanticRuleSignatures
+ 
+ 	^ #(
+ 		(start MethodNode initialFalse #())
+ 		(rvr ParseNode rcvr: #((rvr parentInh)))
+ 		(rvr MethodNode rcvr #())
+ 
+ 		(myNode ParseNode thisNode #())
+ 
+ 		(blockType ParseNode defaultBlockType: #((blockType parentInh)))
+ 		(blockType BlockNode blockType:parentMessageType: #((blockType parentInh) (messageType parentInh)))
+ 		(blockType MethodNode initialBlockType #())
+ 
+ 		(isStatement ParseNode isStmt: #((blockType parentInh)))
+ 		(isStatement MethodNode initialFalse #())
+ 
+ 		(isTopStatement ParseNode isTopStmt: #((isTopStatement parentInh)))
+ 		(isTopStatement BlockNode isTopStmtForBlock: #((isTopStatement parentInh)))
+ 		(isTopStatement MethodNode initialNil #())
+ 
+ 		(messageType ParseNode defaultMessageType #())
+ 		(messageType MessageNode msgType #())
+ 		(messageType AssignmentNode assignmentMsgType #())
+ 
+ 		(receiverObject ParseNode firstInReceivers: #((receiverObject allChildrenSynth)))
+ 		(receiverObject LeafNode initialNil #())
+ 		(receiverObject BlockNode initialNil #())
+ 		(receiverObject VariableNode variableReceiver: #((rvr myInh)))
+ 
+ 		(isInTest ParseNode isTest:parentNode: #((isInTest parentInh) (myNode parentInh)))
+ 		(isInTest MethodNode initialFalse #())
+ 
+ 		(stmtChain ParseNode transfer: #((stmtChain parentInh)))
+ 		(stmtChain MethodNode initialEmptyList #())
+ 		(stmtChain MessageNode addToStmtChain:isStatement: #((stmtChain parentInh) (isStatement myInh)))
+ 
+ 		(nodeInfoIn ParseNode transfer: #((nodeInfoIn parentInhFirstChild)))
+ 		(nodeInfoIn ParseNode transfer: #((nodeInfoOut elderSiblingSynth)))
+ 		(nodeInfoIn MessageNode transfer:isStatement: #((nodeInfoIn parentInhFirstChild) (isStatement myInh)))
+ 		(nodeInfoIn MessageNode transfer:isStatement: #((nodeInfoOut elderSiblingSynth) (isStatement myInh)))
+ 		(nodeInfoIn MethodNode initialDictForNodeInfo #())
+ 
+ 		(nodeInfoOut ParseNode transfer: #((nodeInfoIn myInh)))
+ 		(nodeInfoOut ParseNode transfer: #((nodeInfoOut lastChildSynth)))
+ 		(nodeInfoOut MessageNode 
+ 			addNodeInfoTo:receiverObject:stmtChain:scriptReceiver:messageType:isStatement:isInTest:parentNode:
+ 			#((nodeInfoOut lastChildSynth) (receiverObject mySynth) (stmtChain myInh) (rvr myInh) (messageType mySynth) (isStatement myInh) (isInTest myInh) (myNode parentSynth)))
+ 
+ 		#(primaryBreedPair ParseNode transfer: #((primaryBreedPair parentInh)))
+ 		#(primaryBreedPair MethodNode initialNil #())
+ 		#(primaryBreedPair MessageNode primaryBreedPair:fromDict:isStatement: #((primaryBreedPair parentInh) (nodeInfoOut mySynth) (isStatement myInh)))
+ 
+ 		#(statementType ParseNode transfer: #((statementType parentInh)))
+ 		#(statementType MethodNode initialNil #())
+ 		#(statementType MessageNode determineStatementType:fromDict:primaryBreedPair:messageType:isStatement:receiverObject: #((statementType parentInh) (nodeInfoOut mySynth) (primaryBreedPair mySynth) (messageType mySynth) (isStatement mySynth) (receiverObject mySynth)))
+ 
+ 		#(rewriteInfoIn ParseNode transfer: #((rewriteInfoOut parentSynth)))
+ 		#(rewriteInfoIn MethodNode initialNil #())
+ 		#(rewriteInfoIn MessageNode parentRewriteInfo:primaryBreedPair:isStatement:isTopStatement: #((rewriteInfoOut parentSynth) (primaryBreedPair mySynth) (isStatement mySynth) (isTopStatement mySynth)))
+ 
+ 		#(rewriteInfoOut ParseNode transfer: #((rewriteInfoIn myInh)))
+ 		#(rewriteInfoOut BlockNode blockRewriteInfo:statementType:primaryBreedPair: #((rewriteInfoIn myInh) (statementType myInh) (primaryBreedPair mySynth)))
+ 		#(rewriteInfoOut MessageNode rewriteInfo:statementType:primaryBreedPair:isStatement: #((rewriteInfoIn myInh) (statementType myInh) (primaryBreedPair mySynth) (isStatement mySynth)))
+ 		(rewriteInfoOut VariableNode rewriteVariable:with:rewriteInfo: ((receiverObject mySynth) (primaryBreedPair myInh) (rewriteInfoIn myInh)))
+ 		
+ 
+ 	).
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>thisNode (in category 'rules') -----
+ thisNode
+ 
+ 	^ self.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>transfer: (in category 'rules') -----
+ transfer: val
+ 
+ 	^ val.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>transfer:isStatement: (in category 'rules') -----
+ transfer: givenNodeInfo isStatement: myIsStatement
+ 
+ 	myIsStatement ifTrue: [givenNodeInfo at: self put: OrderedCollection new].
+ 	^ givenNodeInfo.
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>transferBlockType: (in category 'rules') -----
+ transferBlockType: parentBlockType
+ 
+ 	^ #default.
+ 
+ !

Item was added:
+ ----- Method: KedamaTurtleMethodAttributionDefinition2 class>>variableReceiver: (in category 'rules') -----
+ variableReceiver: rec
+ 	| var sym |
+ 	sym _ (self key isKindOf: LookupKey) ifTrue: [^ self key value] ifFalse: [self key].
+ 	var _ Compiler new evaluate: sym asString in: nil to: rec notifying: nil ifFail: [] logged: false.
+ 	^ var.
+ !

Item was changed:
  ----- Method: KedamaTurtleMorph class>>additionsToViewerCategories (in category 'scripting') -----
  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."
  	"self halt."
  	^ #(
  
  	('kedama turtle' (
  		(command die 'delete this turtle')
  
  		(slot upHill 'uphill of the implicit at my location' Number readOnly Player getUphillIn: unspecified unspecified)
  		(slot bounceOn 'detect collision and bounce back' Boolean readOnly Player bounceOn: unspecified unspecified)
+ 		"(slot bounceOnColor 'detect collision and bounce back on a color' Boolean readOnly Player bounceOnColor: unspecified unspecified)"
- 		(slot bounceOnColor 'detect collision and bounce back on a color' Boolean readOnly Player bounceOnColor: unspecified unspecified)
  		(slot patchValueIn 'get the value at this position' Number readWrite Number getPatchValueIn: Number setPatchValueIn:to:)
  		(slot distanceTo 'The distance to another turtle' Number readOnly Player getDistanceTo: unused unused)
  		(slot angleTo 'The angle to another turtle' Number readOnly Player getAngleTo: unused unused)
  
  		(slot getReplicated 'returns a copy of this turtle' Player readOnly Player getReplicated unused unused)
  		(slot x 'The x coordinate' Number readWrite Player getX Player setX:)
  		(slot y  	'The y coordinate' Number readWrite Player 	getY Player setY:)
  		(slot heading 'Which direction the object is facing.  0 is straight up' Number readWrite Player getHeading Player setHeading:)
  		(command forward: 'Moves the object forward in the direction it is heading' Number)
  		(command turn: 'Change the heading of the object by the specified amount' Number)
  			(slot color 'The color of the object' Color readWrite Player getColor  Player  setColor:)
  	"		(slot headingTheta 'The angle, in degrees, that my heading vector makes with the positive x-axis' Number readWrite Player getHeadingTheta Player setHeadingTheta:)
  
  			(slot theta 'The angle between the positive x-axis and the vector connecting the origin to the object''s position' Number readWrite Player getTheta Player setTheta: )
  "
  		(slot turtleVisible 'The flag that governs the visibility of turtle' Boolean readWrite Player getTurtleVisible Player setTurtleVisible:)
  			"(command turtleShow 'make the object visible')
  			(command turtleHide 'make the object invisible')"
  
  		(slot turtleOf 'returns a turtle of specified breed at my position.' Player readOnly Player getTurtleOf: unused unused)
  		"(slot normal 'The normal for bouncing' Number readWrite Player getNormal Player  setNormal:)"
  
+ 		(slot turtleCount 'set the number of turtles' Number readWrite Number getTurtleCount Number setTurtleCount:)
  
  	))
+ 	"('kedama turtle breed' (
- 	('kedama turtle breed' (
- 		(slot turtleCount 'set the number of turtles' Number readWrite Number getTurtleCount Number setTurtleCount:)
  		(slot grouped 'turtles bahaves as one connected objects' Boolean readWrite Boolean getGrouped Boolean setGrouped:)
+ 	))"
- 	))
  
  	('kedama turtle color' (
  		(slot redComponentIn 'The red component in specified patch.' Number readWrite Player getRedComponentIn: Player setRedComponentIn:to:)
  		(slot greenComponentIn 'The green component in specified patch.' Number readWrite Player getGreenComponentIn: Player setGreenComponentIn:to:)
  		(slot blueComponentIn 'The blue component in specified patch.' Number readWrite Player getBlueComponentIn: Player setBlueComponentIn:to:)
  		(command colorFromPatch: 'make my color specified in the patch' Patch)
  		(command colorToPatch: 'store my color into the patch' Patch)
  	))
  
  )
  
  !

Item was changed:
  ----- Method: KedamaTurtleMorph class>>defaultNameStemForInstances (in category 'scripting') -----
  defaultNameStemForInstances
  
+ 	^ 'turtle' translatedNoop
- 	^ 'turtle' translated.
  !

Item was changed:
  ----- Method: KedamaTurtleMorph>>addCustomMenuItems:hand: (in category 'viewer access') -----
  addCustomMenuItems: aCustomMenu hand: aHandMorph
  	"Include our modest command set in the ctrl-menu"
  
  	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
  	self player ifNotNil: [
  		aCustomMenu addLine.
+ 		aCustomMenu add: 'copy methods' target: self player action: #copyAllMethodsAgain2.
- 		aCustomMenu add: 'copy methods' target: self player action: #copyAllMethodsAgain.
  	].
  !

Item was added:
+ ----- Method: KedamaTurtleMorph>>convertToCurrentVersion:refStream: (in category 'initialization') -----
+ convertToCurrentVersion: varDict refStream: smartRefStrm 
+ 	self player copyAllMethodsAgain2.
+ 	^ super convertToCurrentVersion: varDict refStream: smartRefStrm
+ !

Item was changed:
  ----- Method: KedamaTurtleMorph>>install (in category 'initialization') -----
  install
  
  	| t |
  	self player kedamaWorld: kedamaWorld.
+ 	t _ self player createTurtles2.
- 	t := self player createTurtles.
  	kedamaWorld makeTurtles: turtleCount examplerPlayer: self player color: ((self color pixelValueForDepth: 32) bitAnd: 16rFFFFFF) ofPrototype: nil turtles: t randomize: true.
  	self player createSequenceStub.
  !

Item was removed:
- ----- Method: KedamaTurtlePlayer>>forward: (in category 'commands and slots') -----
- forward: dist
- 
- 	self setX: (x + (dist asFloat * headingRadians cos)).
- 	self setY: (y - (dist asFloat * headingRadians sin)).
- !

Item was added:
+ Player subclass: #KedamaTurtleVectorPlayer2
+ 	instanceVariableNames: 'kedamaWorld exampler predicate info types arrays deletingIndex whoTable whoTableBase whoTableValid turtlesMap turtleMapValid lastWho lastWhoStub'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-EToys-Kedama'!

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>isSystemDefined (in category 'as yet unclassified') -----
+ isSystemDefined
+ 	^ (name endsWith: 'Player2')
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>isUniClass (in category 'as yet unclassified') -----
+ isUniClass
+ 
+ 	^ self ~~ self officialClass!

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>officialClass (in category 'as yet unclassified') -----
+ officialClass
+ 
+ 	^ KedamaTurtleVectorPlayer2.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>primDrawOn:destWidth:destHeight:xArray:yArray:colorArray:visibleArray: (in category 'as yet unclassified') -----
+ primDrawOn: bits destWidth: dimX destHeight: dimY xArray: xArray yArray: yArray colorArray: colorArray visibleArray: visibleArray
+ 
+ 	| x y visible bitsIndex |
+ 	<primitive: 'drawTurtlesInArray' module: 'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #drawTurtlesInArray."
+ 
+ 	1 to: xArray size do: [:i |
+ 		x _ (xArray at: i) asInteger.
+ 		y _ (yArray at: i) asInteger.
+ 		visible _ (visibleArray at: i).
+ 		(visible ~= 0 and: [((x >= 0) and: [y >= 0]) and: [(x < dimX) and: [y < dimY]]]) ifTrue: [
+ 			bitsIndex _ ((y * dimX) + x) + 1.
+ 			bits at: bitsIndex put: (colorArray at: i).
+ 		]
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>primDrawPredicate:on:destWidth:destHeight:xArray:yArray:colorArray:visibleArray: (in category 'as yet unclassified') -----
+ primDrawPredicate: predicate on: bits destWidth: dimX destHeight: dimY xArray: xArray yArray: yArray colorArray: colorArray visibleArray: visibleArray
+ 
+ 	| x y visible bitsIndex |
+ 	<primitive: 'drawTurtlesInArray' module: 'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #drawTurtlesInArray."
+ 
+ 	1 to: xArray size do: [:i |
+ 		(predicate at: i) = 1 ifTrue: [
+ 			x _ (xArray at: i) asInteger.
+ 			y _ (yArray at: i) asInteger.
+ 			visible _ (visibleArray at: i).
+ 			(visible ~= 0 and: [((x >= 0) and: [y >= 0]) and: [(x < dimX) and: [y < dimY]]]) ifTrue: [
+ 				bitsIndex _ ((y * dimX) + x) + 1.
+ 				bits at: bitsIndex put: (colorArray at: i).
+ 			]
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>primForwardPredicate:xArray:yArray:headingArray:value:destWidth:destHeight:leftEdgeMode:rightEdgeMode:topEdgeMode:bottomEdgeMode: (in category 'as yet unclassified') -----
+ primForwardPredicate: predicate xArray: xArray yArray: yArray headingArray: headingArray value: v destWidth: destWidth destHeight: destHeight leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode
+ 
+ 	| dist newX newY |
+ 	<primitive: 'primTurtlesForward' module: 'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primTurtlesForward."
+ 
+ 	1 to: xArray size do: [:i |
+ 		(predicate at: i) = 1 ifTrue: [
+ 			v isCollection ifTrue: [
+ 				dist _ (v at: i) asFloat.
+ 			] ifFalse: [
+ 				dist _ v asFloat.
+ 			].
+ 			newX _ (xArray at: i) + (dist * (headingArray at: i) cos).
+ 			newY _ (yArray at: i) - (dist * (headingArray at: i) sin).
+ 			KedamaMorph scalarXAt: i xArray: xArray headingArray: headingArray value: newX destWidth: destWidth leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode.
+ 			KedamaMorph scalarYAt: i yArray: yArray headingArray: headingArray value: newY destHeight: destHeight topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>primGetAngleToX:toY:xArray:yArray:resultInto: (in category 'as yet unclassified') -----
+ primGetAngleToX: pX toY: pY xArray: xArray yArray: yArray resultInto: result
+ 
+ 	| ppx ppy x y ret |
+ 	<primitive: 'vectorGetAngleTo' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #vectorGetAngleTo."
+ 
+ 	ppx _ pX.
+ 	ppy _ pY.
+ 	1 to: result size do: [:index |
+ 		pX isCollection ifTrue: [
+ 			ppx _ pX at: index.
+ 			ppy _ pY at: index.
+ 		].
+ 		x _ ppx - (xArray at: index).
+ 		y _ ppy - (yArray at: index).
+ 		ret _ (x at y) theta radiansToDegrees + 90.0.
+ 		ret > 360.0 ifTrue: [ret _ ret - 360.0].
+ 		result at: index put: ret.
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>primGetDistanceToX:toY:xArray:yArray:resultInto: (in category 'as yet unclassified') -----
+ primGetDistanceToX: pX toY: pY xArray: xArray yArray: yArray resultInto: result
+ 
+ 	| ppx ppy |
+ 	<primitive: 'vectorGetDistanceTo' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #vectorGetDistanceTo."
+ 
+ 	ppx _ pX.
+ 	ppy _ pY.
+ 	1 to: result size do: [:index |
+ 		pX isCollection ifTrue: [
+ 			ppx _ pX at: index.
+ 			ppy _ pY at: index.
+ 		].
+ 		result at: index put: ((ppx - (xArray at: index)) squared + (ppy - (yArray at: index)) squared) sqrt.
+ 
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>primGetHeading:into: (in category 'as yet unclassified') -----
+ primGetHeading: headingArray into: resultArray
+ 
+ 	| heading |
+ 	<primitive: 'getHeadingArrayInto' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #getHeadingArrayInto."
+ 
+ 	1 to: headingArray size do: [:i |
+ 		heading _ headingArray at: i.
+ 		heading _ heading / 0.0174532925199433.
+ 		heading _ 90.0 - heading.
+ 		heading > 0.0 ifFalse: [heading _ heading + 360.0].
+ 		resultArray at: i put: heading.
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>primMakeTurtlesMap:whoArray:xArray:yArray:width:height: (in category 'as yet unclassified') -----
+ primMakeTurtlesMap: map whoArray: whoArray xArray: xArray yArray: yArray width: w height: h
+ 
+ 	<primitive: 'makeTurtlesMap' module: 'KedamaPlugin2'>
+ 	^ nil.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>primRandomRange:from:to:intoFloatArray:factor: (in category 'as yet unclassified') -----
+ primRandomRange: range from: from to: to intoFloatArray: aFloatArray factor: factor
+ 
+ 	<primitive: 'randomIntoFloatArray' module: 'KedamaPlugin2'>
+ 	^ nil.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>primRandomRange:from:to:intoIntegerArray:factor: (in category 'as yet unclassified') -----
+ primRandomRange: range from: from to: to intoIntegerArray: anIntegerArray factor: factor
+ 
+ 	<primitive: 'randomIntoIntegerArray' module: 'KedamaPlugin2'>
+ 	^ nil.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>primSetPredicate:heading:from: (in category 'as yet unclassified') -----
+ primSetPredicate: predicates heading: headingArray from: val
+ 
+ 	| heading |
+ 	<primitive: 'setHeadingArrayFrom' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #setHeadingArrayFrom."
+ 
+ 	val isCollection ifFalse: [
+ 		heading _ val asFloat.
+ 		heading _ KedamaMorph degreesToRadians: heading.
+ 	].
+ 
+ 	1 to: headingArray size do: [:i |
+ 		(predicates at: i) = 1 ifTrue: [
+ 			val isCollection ifTrue: [
+ 				heading _ val at: i.
+ 				heading _ KedamaMorph degreesToRadians: heading.
+ 			].
+ 			headingArray at: i put: heading.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>primSetXPredicates:xArray:headingArray:value:destWidth:leftEdgeMode:rightEdgeMode: (in category 'as yet unclassified') -----
+ primSetXPredicates: predicates xArray: xArray headingArray: headingArray value: v destWidth: destWidth leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode
+ 
+ 	| val newX |
+ 	<primitive: 'turtlesSetX' module: 'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #turtlesSetX."
+ 
+ 	v isCollection ifFalse: [
+ 		val _ v asFloat.
+ 	].
+ 
+ 	1 to: xArray size do: [:i |
+ 		(predicates at: i) = 1 ifTrue: [
+ 			v isCollection ifTrue: [
+ 				newX _ v at: i.
+ 			] ifFalse: [
+ 				newX _ val.
+ 			].
+ 			KedamaMorph scalarXAt: i xArray: xArray headingArray: headingArray value: newX destWidth: destWidth leftEdgeMode: leftEdgeMode rightEdgeMode: rightEdgeMode.
+ 		].
+ 	].
+ 
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>primSetYPredicates:yArray:headingArray:value:destHeight:topEdgeMode:bottomEdgeMode: (in category 'as yet unclassified') -----
+ primSetYPredicates: predicates yArray: yArray headingArray: headingArray value: v destHeight: destHeight topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode
+ 
+ 	| val newY |
+ 	<primitive: 'turtlesSetY' module: 'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #turtlesSetY."
+ 
+ 	v isCollection ifFalse: [
+ 		val _ v asFloat.
+ 	].
+ 
+ 	1 to: yArray size do: [:i |
+ 		(predicates at: i) = 1 ifTrue: [
+ 			v isCollection ifTrue: [
+ 				newY _ v at: i.
+ 			] ifFalse: [
+ 				newY _ val.
+ 			].
+ 			KedamaMorph scalarYAt: i yArray: yArray headingArray: headingArray value: newY destHeight: destHeight topEdgeMode: topEdgeMode bottomEdgeMode: bottomEdgeMode.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>randomRange:from:to:intoFloatArray:factor:kedamaWorld: (in category 'as yet unclassified') -----
+ randomRange: range from: from to: to intoFloatArray: aFloatArray factor: factor kedamaWorld: kedamaWorld
+ 
+ 	| ret |
+ 	ret _ self primRandomRange: range from: from to: to intoFloatArray: aFloatArray factor: factor.
+ 	ret ifNil: [
+ 		from to: to do: [:index |
+ 			aFloatArray at: index put: (kedamaWorld random: range) asFloat * factor.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>randomRange:from:to:intoIntegerArray:factor:kedamaWorld: (in category 'as yet unclassified') -----
+ randomRange: range from: from to: to intoIntegerArray: anIntegerArray factor: factor kedamaWorld: kedamaWorld
+ 
+ 	| ret |
+ 	ret _ self primRandomRange: range from: from to: to intoIntegerArray: anIntegerArray factor: factor.
+ 	ret ifNil: [
+ 		from to: to do: [:index |
+ 			anIntegerArray at: index put: ((kedamaWorld random: range) asFloat * factor) asInteger.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2 class>>wantsChangeSetLogging (in category 'as yet unclassified') -----
+ wantsChangeSetLogging
+ 	"Log changes for Player itself, but not for automatically-created subclasses like Player1, Player2, but *do* log it for uniclasses that have been manually renamed."
+ 
+ 	^ (self == KedamaTurtleVectorPlayer2 or:
+ 		[(self name beginsWith: 'KedamaTurtleVectorPlayer2') not]) or:
+ 			[Preferences universalTiles]!

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>aTurtleAtX:y: (in category 'turtle map') -----
+ aTurtleAtX: xPos y: yPos
+ 
+ 	| w x y index who stub |
+ 	turtleMapValid ifFalse: [
+ 		self makeTurtlesMap.
+ 	].
+ 
+ 	w _ kedamaWorld dimensions x.
+ 	x _ xPos truncated.
+ 	y _ yPos truncated.
+ 	x < 0 ifTrue: [^ nil].
+ 	x >= w ifTrue: [^ nil].
+ 	y < 0 ifTrue: [^ nil].
+ 	y >= kedamaWorld dimensions y ifTrue: [^ nil].
+ 	index _ (w * y) + x + 1.
+ 	who _ turtlesMap at: index.
+ 	who = 0 ifTrue: [^ nil].
+ 	who = lastWho ifTrue: [^ lastWhoStub].
+ 	stub _ exampler clonedSequentialStub.
+ 	stub who: who.
+ 	lastWho _ who.
+ 	^ lastWhoStub _ stub.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>addInstanceVarNamed:withValue: (in category 'player protocol') -----
+ addInstanceVarNamed: aName withValue: aValue
+ 
+ 	| newArray |
+ 	newArray := self arrayForType: aValue.
+ 	
+ 	arrays := arrays,(Array with: newArray).
+ 	newArray atAllPut: aValue.
+ 	info at: aName asSymbol put: arrays size.
+ 	types at: arrays size put: aValue
+ 
+ 
+ 	
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>addInstanceVarVectorNamed:withValue: (in category 'player protocol') -----
+ addInstanceVarVectorNamed: aName withValue: aValue
+ 
+ 	| newArray |
+ 	newArray _ KedamaFloatArray new: self size.
+ 	arrays _ arrays, (Array with: newArray).
+ 	newArray atAllPut: aValue.
+ 	info at: aName asSymbol put: arrays size.
+ 	types at: arrays size put: #Number.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>addTurtlesCount:ofPrototype:for:positionAndColorArray: (in category 'add turtles') -----
+ addTurtlesCount: count ofPrototype: prototype for: aKedamaWorld positionAndColorArray: positionAndColorArray
+ 
+ 	| index array defaultValue newArray oldCount |
+ 	oldCount _ self size.
+ 	info associationsDo: [:assoc |
+ 		index _ assoc value.
+ 		array _ arrays at: index.
+ 		defaultValue _ prototype at: index.
+ 		newArray _ array class new: count.
+ 		(#(who x y heading color predicate) includes: assoc key) ifFalse: [
+ 			newArray atAllPut: defaultValue.
+ 		].
+ 		assoc key = #x ifTrue: [newArray replaceFrom: 1 to: newArray size with: positionAndColorArray first startingAt: 1].
+ 		assoc key = #y ifTrue: [newArray replaceFrom: 1 to: newArray size with: positionAndColorArray second startingAt: 1].
+ 		assoc key = #color ifTrue: [newArray replaceFrom: 1 to: newArray size with: positionAndColorArray third startingAt: 1].
+ 		assoc key = #heading ifTrue: [newArray atAllPut: 1.57079631 "Float pi / 2.0"].
+ 		assoc key = #normal ifTrue: [newArray atAllPut: 1.57079631 "Float pi / 2.0"].
+ 
+ 		arrays at: (assoc value) put: array, newArray.
+ 	].
+ 	predicate _ arrays at: 7.
+ 	predicate from: oldCount+1 to: predicate size put: 1.
+ 
+ 	#(who) do: [:name |
+ 		self setInitialValueOf: name from: oldCount + 1 to: self size for: aKedamaWorld.
+ 	].
+ 	whoTableValid _ false.
+ 	turtleMapValid _ false.
+ 	kedamaWorld drawRequest.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>addTurtlesCount:ofPrototype:for:randomize: (in category 'add turtles') -----
+ addTurtlesCount: count ofPrototype: prototype for: aKedamaWorld randomize: randomizeFlag
+ 
+ 	| index array defaultValue newArray oldCount |
+ 	oldCount _ self size.
+ 	info associationsDo: [:assoc |
+ 		index _ assoc value.
+ 		array _ arrays at: index.
+ 		defaultValue _ prototype at: index.
+ 		newArray _ array class new: count.
+ 		newArray atAllPut: defaultValue.
+ 		arrays at: index put: (array, newArray).
+ 	].
+ 	predicate _ arrays at: 7.
+ 	predicate from: oldCount + 1 to: predicate size put: 1.
+ 
+ 	self setInitialValueOf: #who from: oldCount + 1 to: self size for: aKedamaWorld.
+ 
+ 	randomizeFlag ifTrue: [
+ 		#(x y heading) do: [:name |
+ 			self setInitialValueOf: name from: oldCount + 1 to: self size for: aKedamaWorld.
+ 		].
+ 	].
+ 	whoTableValid _ false.
+ 	kedamaWorld drawRequest.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>arrayForType: (in category 'private') -----
+ arrayForType: typeName
+ 
+ 	| newArray |
+ 	(typeName = #Number) ifTrue: [
+ 		newArray _ KedamaFloatArray new: self size.
+ 	].
+ 	(typeName = #Color) ifTrue: [
+ 		newArray _ WordArray new: self size.
+ 	].
+ 	(typeName = #Boolean) ifTrue: [
+ 		newArray _ ByteArray new: self size.
+ 	].
+ 
+ 	newArray ifNil: [
+ 		newArray _ Array new: self size.
+ 	].
+ 
+ 	^ newArray.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>arrays (in category 'accessing') -----
+ arrays
+ 
+ 	^ arrays.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>basicMakeTurtlesMap (in category 'turtle map') -----
+ basicMakeTurtlesMap
+ 
+ 	| x y xArray yArray width height mapIndex whoArray |
+ 	xArray _ arrays at: 2.
+ 	yArray _ arrays at: 3.
+ 	whoArray _ arrays at: 1.
+ 	width _ kedamaWorld dimensions x.
+ 	height _ kedamaWorld dimensions y.
+ 	turtlesMap atAllPut: 0.
+ 
+ 	1 to: self size do: [:index |
+ 		x _ (xArray at: index) truncated.
+ 		y _ (yArray at: index) truncated.
+ 		mapIndex _ (width * y) + x + 1.
+ 		(0 < mapIndex and: [mapIndex <= turtlesMap size]) ifTrue: [
+ 			turtlesMap at: mapIndex put: (whoArray at: index).
+ 		].
+ 	].
+ 
+ 	turtleMapValid _ true.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>color: (in category 'player commands') -----
+ color: c
+ 
+ 	c isColor ifTrue: [
+ 		self setColorVarAt: 5 put: ((c pixelValueForDepth: 32) bitAnd: 16rFFFFFF).
+ 	] ifFalse: [
+ 		self setColorVarAt: 5 put: c.
+ 	].
+ 	kedamaWorld drawRequest.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>colorFromPatch: (in category 'player commands') -----
+ colorFromPatch: aPatch
+ 
+ 	| xArray yArray cArray patch |
+ 	xArray _ arrays at: 2.
+ 	yArray _ arrays at: 3.
+ 	cArray _ arrays at: 5.
+ 	patch _ aPatch costume renderedMorph.
+ 	1 to: self size do: [:i |
+ 		(predicate at: i) = 1 ifTrue: [
+ 			cArray at: i put: ((patch pixelAtX: (xArray at: i) y: (yArray at: i)) bitAnd: 16rFFFFFF).
+ 		].
+ 	].
+ 	kedamaWorld drawRequest.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>colorToPatch: (in category 'player commands') -----
+ colorToPatch: aPatch
+ 
+ 	| xArray yArray cArray patch |
+ 	xArray _ arrays at: 2.
+ 	yArray _ arrays at: 3.
+ 	cArray _ arrays at: 5.
+ 	patch _ aPatch costume renderedMorph.
+ 	1 to: self size do: [:i |
+ 		(predicate at: i) = 1 ifTrue: [
+ 			patch pixelAtX: (xArray at: i) y: (yArray at: i) put: (cArray at: i).
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>compileAllAccessors (in category 'player protocol') -----
+ compileAllAccessors
+ 
+ 	info keys asArray do: [:k |
+ 		(#(who x y heading color visible predicate) includes: k) ifFalse: [
+ 			self compileVectorInstVarAccessorsFor: k.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>compileVectorInstVarAccessorsFor: (in category 'player protocol') -----
+ compileVectorInstVarAccessorsFor: varName
+ 
+ 	| nameString index type setPhrase |
+ 	nameString _ varName asString capitalized.
+ 	index _ info at: varName asSymbol.
+ 	self class compileSilently: ('get', nameString, '
+ 	^ ', '(arrays at: ', index printString, ')')
+ 		classified: 'access'.
+ 
+ 	type _ types at: index.
+ 	type = #Number ifTrue: [
+ 		setPhrase _ 'setNumberVarAt:'.
+ 	].
+ 	type = #Boolean ifTrue: [
+ 		setPhrase _ 'setBooleanVarAt:'.
+ 	].
+ 	type = #Color ifTrue: [
+ 		setPhrase _ 'setColorVarAt:'.
+ 	].
+ 	setPhrase ifNil: [setPhrase _ 'setObjectVarAt:'].
+ 
+ 	self class compileSilently: ('set', nameString, ': xxxArg
+ 	self ', setPhrase, index printString, ' put: xxxArg')
+ 		classified: 'access'!

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>delete (in category 'deleting') -----
+ delete
+ 
+ 	| anInstance |
+ 	exampler _ nil.
+ 	arrays _ nil.
+ 	whoTable _ nil.
+ 	turtlesMap _ nil.
+ 	self class removeFromSystem: false.
+ 	anInstance := UnscriptedPlayer new.
+ 	self become: anInstance.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>deleteTurtleID: (in category 'player commands') -----
+ deleteTurtleID: who
+ 
+ 	| whoArray whoIndex newArray |
+ 	whoArray _ arrays at: 1.
+ 	whoIndex _ whoArray indexOf: who ifAbsent: [^ self].
+ 	deletingIndex _ whoIndex - 1.
+ 	arrays withIndexDo: [:array :index |
+ 		newArray _ (array copyFrom: 1 to: whoIndex - 1), (array copyFrom: whoIndex + 1 to: array size).
+ 		arrays at: index put: newArray.
+ 	].
+ 	predicate _ arrays at: 7.
+ 	whoTableValid _ false.
+ 	turtleMapValid _ false.
+ 	kedamaWorld drawRequest.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>doCommand: (in category 'command execution') -----
+ doCommand: aBlock
+ 
+ 	^ aBlock value: self.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>doDieCommand: (in category 'command execution') -----
+ doDieCommand: aBlock
+ 
+ 	^ exampler doDieCommand: aBlock.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>doExamplerCommand: (in category 'command execution') -----
+ doExamplerCommand: aBlock
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>doSequentialCommand: (in category 'command execution') -----
+ doSequentialCommand: aBlock
+ 
+ 	^ exampler doSequentialCommand: aBlock.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>drawOn: (in category 'displaying') -----
+ drawOn: aForm
+ 
+ 	| xArray yArray colorArray visibleArray bits dimX dimY |
+ 	xArray _ arrays at: 2.
+ 	yArray _ arrays at: 3.
+ 	colorArray _ arrays at: 5.
+ 	visibleArray _ arrays at: 6.
+ 	bits _ aForm bits.
+ 	dimX _ aForm width.
+ 	dimY _ aForm height.
+ 
+ 	KedamaTurtleVectorPlayer2 primDrawOn: bits destWidth: dimX destHeight: dimY xArray: xArray yArray: yArray colorArray: colorArray visibleArray: visibleArray.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>exampler: (in category 'accessing') -----
+ exampler: e
+ 
+ 	exampler _ e.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>forward: (in category 'player commands') -----
+ forward: val
+ 
+ 	exampler getGrouped ifFalse: [
+ 		KedamaTurtleVectorPlayer2 primForwardPredicate: predicate xArray: (arrays at: 2) yArray: (arrays at: 3) headingArray: (arrays at: 4) value: (val isNumber ifTrue: [val asFloat] ifFalse: [val]) destWidth: kedamaWorld wrapX asFloat destHeight: kedamaWorld wrapY asFloat leftEdgeMode: kedamaWorld leftEdgeModeMnemonic rightEdgeMode: kedamaWorld rightEdgeModeMnemonic topEdgeMode: kedamaWorld topEdgeModeMnemonic bottomEdgeMode: kedamaWorld bottomEdgeModeMnemonic.
+ 	] ifTrue: [
+ 		self groupForward: val
+ 	].
+ 	turtleMapValid _ false.
+ 	kedamaWorld drawRequest.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getAngleTo: (in category 'player commands') -----
+ getAngleTo: players
+ 
+ 	| p xArray yArray result pX pY xy |
+ 	players isCollection ifFalse: [
+ 		p _ players
+ 	].
+ 	xArray _ arrays at: 2.
+ 	yArray _ arrays at: 3.
+ 	result _ KedamaFloatArray new: self size.
+ 	players isCollection ifTrue: [
+ 		pX _ KedamaFloatArray new: players size.
+ 		pY _ KedamaFloatArray new: players size.
+ 		1 to: players size do: [:i |
+ 			xy _ (players at: i) getXAndY.
+ 			pX at: i put: xy x.
+ 			pY at: i put: xy y.
+ 		].
+ 	] ifFalse: [
+ 		xy _ p getXAndY.
+ 		pX _ xy x.
+ 		pY _ xy y.
+ 	].
+ 	^ KedamaTurtleVectorPlayer2 primGetAngleToX: pX toY: pY xArray: xArray yArray: yArray resultInto: result.
+ 
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getBlueComponentIn: (in category 'player commands') -----
+ getBlueComponentIn: aPatch
+ 
+ 	| pix xArray yArray patch w |
+ 	xArray _ arrays at: 2.
+ 	yArray _ arrays at: 3.
+ 	patch _ aPatch costume renderedMorph.
+ 	w _ WordArray new: self size.
+ 	1 to: self size do: [:i |
+ 		pix _ patch pixelAtX: (xArray at: i) y: (yArray at: i).
+ 		w at: i put: (pix bitAnd: 16rFF).
+ 	].
+ 	^ w.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getBooleanVarAt: (in category 'accessing - private') -----
+ getBooleanVarAt: index
+ 
+ 	^ arrays at: index.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getColor (in category 'player commands') -----
+ getColor
+ 
+ 	^ self getVarAt: 5.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getColorVarAt: (in category 'accessing - private') -----
+ getColorVarAt: index
+ 
+ 	^ (arrays at: index) collect: [:c | Color colorFromPixelValue: c depth: 32].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getDistanceTo: (in category 'player commands') -----
+ getDistanceTo: players
+ 
+ 	| p xArray yArray result pX pY xy |
+ 	players isCollection ifFalse: [
+ 		p _ players
+ 	].
+ 	xArray _ arrays at: 2.
+ 	yArray _ arrays at: 3.
+ 	result _ KedamaFloatArray new: self size.
+ 	players isCollection ifTrue: [
+ 		pX _ KedamaFloatArray new: players size.
+ 		pY _ KedamaFloatArray new: players size.
+ 		1 to: players size do: [:i |
+ 			xy _ (players at: i) getXAndY.
+ 			pX at: i put: xy x.
+ 			pY at: i put: xy y.
+ 		].
+ 	] ifFalse: [
+ 		xy _ p getXAndY.
+ 		pX _ xy x.
+ 		pY _ xy y.
+ 	].
+ 	^ KedamaTurtleVectorPlayer2 primGetDistanceToX: pX toY: pY xArray: xArray yArray: yArray resultInto: result.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getGreenComponentIn: (in category 'player commands') -----
+ getGreenComponentIn: aPatch
+ 
+ 	| pix xArray yArray patch w |
+ 	xArray _ arrays at: 2.
+ 	yArray _ arrays at: 3.
+ 	patch _ aPatch costume renderedMorph.
+ 	w _ WordArray new: self size.
+ 	1 to: self size do: [:i |
+ 		pix _ patch pixelAtX: (xArray at: i) y: (yArray at: i).
+ 		w at: i put: ((pix bitShift: -8) bitAnd: 16rFF).
+ 	].
+ 	^ w.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getGrouped (in category 'player commands') -----
+ getGrouped
+ 
+ 	^ exampler getGrouped.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getHeading (in category 'player commands') -----
+ getHeading
+ 
+ 	| heading result ret |
+ 	heading _ (arrays at: 4).
+ 	result _ KedamaFloatArray new: heading size.
+ 	ret _ KedamaTurtleVectorPlayer2 primGetHeading: heading into: result.
+ 	ret ifNotNil: [^ result].
+ 	!

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getPatchValueIn: (in category 'player commands') -----
+ getPatchValueIn: aPatch
+ 
+ 	| w patch xArray yArray |
+ 	w _ WordArray new: self size.
+ 	patch _ aPatch costume renderedMorph.
+ 	xArray _ arrays at: 2.
+ 	yArray _ arrays at: 3.
+ 	patch pixelsAtXArray: xArray yArray: yArray into: w.
+ 	^ w.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getRedComponentIn: (in category 'player commands') -----
+ getRedComponentIn: aPatch
+ 
+ 	| pix xArray yArray patch w |
+ 	xArray _ arrays at: 2.
+ 	yArray _ arrays at: 3.
+ 	patch _ aPatch costume renderedMorph.
+ 	w _ WordArray new: self size.
+ 	1 to: self size do: [:i |
+ 		pix _ patch pixelAtX: (xArray at: i) y: (yArray at: i).
+ 		w at: i put: ((pix bitShift: -16) bitAnd: 16rFF).
+ 	].
+ 	^ w.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getTurtleAt: (in category 'player commands') -----
+ getTurtleAt: aPlayer
+ 
+ 	| xy |
+ 	aPlayer isCollection ifTrue: [
+ 		self error: 'should not happen'.
+ 	].
+ 	xy _ aPlayer getXAndY.
+ 	^ (self aTurtleAtX: xy x y: xy y) ifNil: [^ aPlayer].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getTurtleCount (in category 'player protocol') -----
+ getTurtleCount
+ 
+ 	^ exampler getTurtleCount.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getTurtleOf: (in category 'player commands') -----
+ getTurtleOf: aBreedPlayer
+ 
+ 	| xy |
+ 	aBreedPlayer isCollection ifTrue: [
+ 		"self error: 'should not happen'."
+ 		^ aBreedPlayer.
+ 	].
+ 	xy _ aBreedPlayer getXAndY.
+ 	^ (self aTurtleAtX: xy x y: xy y) ifNil: [^ aBreedPlayer].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getTurtleVisible (in category 'player commands') -----
+ getTurtleVisible
+ 
+ 	^ (arrays at: 6) collect: [:t | t = 1].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getUphillIn: (in category 'player commands') -----
+ getUphillIn: aPatch
+ 
+ 	| xArray yArray headingArray result patch |
+ 	xArray _ arrays at: 2.
+ 	yArray _ arrays at: 3.
+ 	headingArray _ arrays at: 4.
+ 	result _ KedamaFloatArray new: self size.
+ 	patch _ aPatch costume renderedMorph.
+ 	1 to: self size do: [:index |
+ 		result at: index put: (patch
+ 			uphillForTurtleX: (xArray at: index)
+ 			turtleY: (yArray at: index)
+ 			turtleHeading: (headingArray at: index)).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getVarAt: (in category 'accessing - private') -----
+ getVarAt: index
+ 
+ 	^ arrays at: index.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getX (in category 'player commands') -----
+ getX
+ 
+ 	| xArray |
+ 	exampler getGrouped ifFalse: [
+ 		^ arrays at: 2.
+ 	] ifTrue: [
+ 		xArray _ arrays at: 2.
+ 		xArray size = 0 ifTrue: [^ exampler getX].
+ 		^ xArray first.
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>getY (in category 'player commands') -----
+ getY
+ 
+ 	| yArray |
+ 	exampler getGrouped ifFalse: [
+ 		^ arrays at: 3.
+ 	] ifTrue: [
+ 		yArray _ arrays at: 3.
+ 		yArray size = 0 ifTrue: [^ exampler getY].
+ 		^ yArray first.
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>groupForward: (in category 'private') -----
+ groupForward: dist
+ 
+ 	| x y headingRadians |
+ 	self size = 0 ifTrue: [^ self].
+ 
+ 	x _ (arrays at: 2) first.
+ 	y _ (arrays at: 3) first.
+ 	headingRadians _ (arrays at: 4) first.
+ 	self groupSetX: (x + (dist asFloat * headingRadians cos)).
+ 	self groupSetY: (y - (dist asFloat * headingRadians sin)).
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>groupSetX: (in category 'private') -----
+ groupSetX: val
+ 
+ 	| xArray headingArray origX origHeading leftEdgeMode rightEdgeMode newArray wrapX minX maxX |
+ 	self size = 0 ifTrue: [^ self].
+ 	xArray _ arrays at: 2.
+ 	headingArray _ arrays at: 4.
+ 	
+ 	origX _ xArray first.
+ 	origHeading _ headingArray first.
+ 
+ 	leftEdgeMode _ kedamaWorld leftEdgeModeMnemonic.
+ 	rightEdgeMode _ kedamaWorld rightEdgeModeMnemonic.
+ 
+ 	newArray _ xArray collect: [:e | e + val - origX].
+ 	wrapX _ kedamaWorld wrapX.
+ 	minX _ newArray min.
+ 	maxX _ newArray max.
+ 	((minX < 0.0) not and: [(maxX >= wrapX) not]) ifTrue: [
+ 		arrays at: 2 put: newArray.
+ 		^ self.
+ 	].
+ 
+ 	minX < 0.0 ifTrue: [
+ 		leftEdgeMode = 1 ifTrue: [
+ 			newArray withIndexDo: [:e :i |
+ 				e < 0.0 ifTrue: [newArray at: i put: e + wrapX].
+ 			].
+ 		].
+ 		leftEdgeMode = 2 ifTrue: [
+ 			newArray withIndexDo: [:e :i |
+ 				newArray at: i put: e - minX.
+ 			].
+ 		].
+ 		leftEdgeMode = 3 ifTrue: [
+ 			newArray withIndexDo: [:e :i |
+ 				newArray at: i put: e + (minX * -2.0).
+ 			].
+ 		].		
+ 	].
+ 
+ 	maxX >= wrapX ifTrue: [
+ 		rightEdgeMode = 1 ifTrue: [
+ 			newArray withIndexDo: [:e :i |
+ 				e >= wrapX ifTrue: [newArray at: i put: e - wrapX].
+ 			].
+ 		].
+ 		rightEdgeMode = 2 ifTrue: [
+ 			newArray withIndexDo: [:e :i |
+ 				newArray at: i put: e - (maxX - wrapX) - 2.35099e-038.
+ 			].
+ 		].
+ 		rightEdgeMode = 3 ifTrue: [
+ 			newArray withIndexDo: [:e :i |
+ 				newArray at: i put: e - ((maxX - wrapX) * 2.0) - 2.35099e-038.
+ 			].
+ 		].
+ 	].
+ 
+ 	arrays at: 2 put: newArray.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>groupSetY: (in category 'private') -----
+ groupSetY: val
+ 
+ 	| yArray headingArray origY origHeading topEdgeMode bottomEdgeMode newArray wrapY minY maxY |
+ 	self size = 0 ifTrue: [^ self].
+ 	yArray _ arrays at: 3.
+ 	headingArray _ arrays at: 4.
+ 	
+ 	origY _ yArray first.
+ 	origHeading _ headingArray first.
+ 
+ 	topEdgeMode _ kedamaWorld topEdgeModeMnemonic.
+ 	bottomEdgeMode _ kedamaWorld bottomEdgeModeMnemonic.
+ 
+ 	newArray _ yArray collect: [:e | e + val - origY].
+ 	wrapY _ kedamaWorld wrapY.
+ 	minY _ newArray min.
+ 	maxY _ newArray max.
+ 	((minY < 0.0) not and: [(maxY >= wrapY) not]) ifTrue: [
+ 		arrays at: 3 put: newArray.
+ 		^ self.
+ 	].
+ 
+ 	minY < 0.0 ifTrue: [
+ 		topEdgeMode = 1 ifTrue: [
+ 			newArray withIndexDo: [:e :i |
+ 				e < 0.0 ifTrue: [newArray at: i put: e + wrapY].
+ 			].
+ 		].
+ 		topEdgeMode = 2 ifTrue: [
+ 			newArray withIndexDo: [:e :i |
+ 				newArray at: i put: e - minY.
+ 			].
+ 		].
+ 		topEdgeMode = 3 ifTrue: [
+ 			newArray withIndexDo: [:e :i |
+ 				newArray at: i put: e + (minY * -2.0).
+ 			].
+ 		].		
+ 	].
+ 
+ 	maxY >= wrapY ifTrue: [
+ 		bottomEdgeMode = 1 ifTrue: [
+ 			newArray withIndexDo: [:e :i |
+ 				e >= wrapY ifTrue: [newArray at: i put: e - wrapY].
+ 			].
+ 		].
+ 		bottomEdgeMode = 2 ifTrue: [
+ 			newArray withIndexDo: [:e :i |
+ 				newArray at: i put: e - (maxY - wrapY) - 2.35099e-038.
+ 			].
+ 		].
+ 		bottomEdgeMode = 3 ifTrue: [
+ 			newArray withIndexDo: [:e :i |
+ 				newArray at: i put: e - ((maxY - wrapY) * 2.0) - 2.35099e-038.
+ 			].
+ 		].
+ 	].
+ 
+ 	arrays at: 3 put: newArray.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>heading (in category 'player commands') -----
+ heading
+ 
+ 	^ self getHeading.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>heading: (in category 'player commands') -----
+ heading: degrees
+ 
+ 	| deg |
+ 	deg _ degrees isNumber ifTrue: [degrees asFloat] ifFalse: [degrees].
+ 	KedamaTurtleVectorPlayer2 primSetPredicate: predicate heading: (arrays at: 4) from: deg.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>hide (in category 'player commands') -----
+ hide
+ 
+ 	(arrays at: 6) atAllPut: 0.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>indexOf: (in category 'enumeration') -----
+ indexOf: who
+ 
+ 	| whoArray |
+ 	whoTableValid ifTrue: [^ whoTable at: (who - whoTableBase)].
+ 
+ 	whoArray _ arrays at: 1.
+ 
+ 	whoArray size = 0 ifTrue: [^ 0].
+ 
+ 	whoTableBase _ whoArray first - 1.
+ 	whoTable _ WordArray new: whoArray last - whoTableBase.
+ 	1 to: whoArray size do: [:w |
+ 		whoTable at: (whoArray at: w) - whoTableBase put: w.
+ 	].
+ 	whoTableValid _ true.
+ 
+ 	^ whoTable at: (who - whoTableBase).
+ 
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>info (in category 'accessing') -----
+ info
+ 
+ 	^ info.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	super initialize.
+ 	info _ IdentityDictionary new.
+ 	predicate _ ByteArray new: 0.
+ 	info at: #who put: 1.
+ 	info at: #x put: 2.
+ 	info at: #y put: 3.
+ 	info at: #heading put: 4.
+ 	info at: #color put: 5.
+ 	info at: #visible put: 6.
+ 	info at: #predicate put: 7.
+ 
+ 	arrays _ Array new: 7.
+ 	arrays at: (info at: #who) put: (WordArray new: 0).
+ 	arrays at: (info at: #x) put: (KedamaFloatArray new: 0).
+ 	arrays at: (info at: #y) put: (KedamaFloatArray new: 0).
+ 	arrays at: (info at: #heading) put: (KedamaFloatArray new: 0).
+ 	arrays at: (info at: #color) put: (WordArray new: 0).
+ 	arrays at: (info at: #visible) put: (ByteArray new: 0).
+ 	arrays at: (info at: #predicate) put: predicate.
+ 
+ 	types _ Array new: 64.
+ 
+ 	types at: 1 put: #Integer.
+ 	types at: 2 put: #Number.
+ 	types at: 3 put: #Number.
+ 	types at: 4 put: #Number.
+ 	types at: 5 put: #Color.
+ 	types at: 6 put: #Boolean.
+ 	types at: 7 put: #Boolean.
+ 
+ 	whoTableValid _ false.
+ 	turtleMapValid _ false.
+ 
+ 
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>initializeDeletingIndex (in category 'enumeration') -----
+ initializeDeletingIndex
+ 
+ 	deletingIndex _ 0.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>instSize (in category 'accessing') -----
+ instSize
+ 
+ 	^ arrays size.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>invalidateTurtleMap (in category 'turtle map') -----
+ invalidateTurtleMap
+ 
+ 	turtleMapValid _ false.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>kedamaWorld: (in category 'accessing') -----
+ kedamaWorld: k
+ 
+ 	kedamaWorld _ k.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>makePrototypeFromFirstInstance (in category 'add turtles') -----
+ makePrototypeFromFirstInstance
+ 
+ 	^ (1 to: arrays size) collect: [:index |
+ 		(arrays at: index) first
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>makeTurtlesMap (in category 'turtle map') -----
+ makeTurtlesMap
+ 
+ 	| xArray yArray width height whoArray ret |
+ 	xArray _ arrays at: 2.
+ 	yArray _ arrays at: 3.
+ 	whoArray _ arrays at: 1.
+ 	width _ kedamaWorld dimensions x.
+ 	height _ kedamaWorld dimensions y.
+ 	turtlesMap ifNil: [turtlesMap _ WordArray new: width * height].
+ 
+ 	ret _ KedamaTurtleVectorPlayer2 primMakeTurtlesMap: turtlesMap whoArray: whoArray xArray: xArray yArray: yArray width: width height: height.
+ 
+ 	ret ifNil: [self basicMakeTurtlesMap].
+ 
+ 	turtleMapValid _ true.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>nextDeletingIndex (in category 'enumeration') -----
+ nextDeletingIndex
+ 
+ 	^ deletingIndex _ deletingIndex + 1.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>noteRenameOf:to:inPlayer: (in category 'player protocol') -----
+ noteRenameOf: oldSlotName to: newSlotName inPlayer: aPlayer
+ 
+ 	self compileAllAccessors
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>removeVectorSlotNamed: (in category 'player protocol') -----
+ removeVectorSlotNamed: aSlotName
+ 
+ 	| index newArrays |
+ 	index _ info at: aSlotName asSymbol ifAbsent: [^ self].
+ 	newArrays _ (arrays copyFrom: 1 to: index - 1), (arrays copyFrom: index + 1 to: arrays size).
+ 	types replaceFrom: index to: types size - 1 with: types startingAt: index + 1.
+ 
+ 	info removeKey: aSlotName asSymbol.
+ 	info associationsDo: [:assoc | assoc value > index ifTrue: [info at: assoc key put: assoc value - 1]].
+ 	arrays _ newArrays.
+ 	self class removeSelectorSilently: (Utilities getterSelectorFor: aSlotName).
+ 	self class removeSelectorSilently: (Utilities setterSelectorFor: aSlotName).
+ 	self compileAllAccessors.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>renameVectorSlot:newSlotName: (in category 'player protocol') -----
+ renameVectorSlot: oldSlotName newSlotName: newSlotName
+ 
+ 	| index |
+ 	index _ info at: oldSlotName asSymbol ifAbsent: [^ self].
+ 	info removeKey: oldSlotName asSymbol.
+ 	info at: newSlotName put: index.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>setBlueComponentIn:to: (in category 'player commands') -----
+ setBlueComponentIn: aPatch to: value
+ 
+ 	| pix xArray yArray patch component |
+ 	xArray _ arrays at: 2.
+ 	yArray _ arrays at: 3.
+ 	patch _ aPatch costume renderedMorph.
+ 	value isCollection ifFalse: [
+ 		component _ value asInteger bitAnd: 16rFF.
+ 	].
+ 	(1 to: self size) do: [:i |
+ 		(predicate at: i) = 1 ifTrue: [
+ 			value isCollection ifTrue: [
+ 				component _ (value at: i) asInteger bitAnd: 16rFF.
+ 			].
+ 			pix _ patch pixelAtX: (xArray at: i) y: (yArray at: i).
+ 			pix _ (pix bitAnd: 16rFFFF00) bitOr: component.
+ 			patch pixelAtX: (xArray at: i) y: (yArray at: i) put: pix.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>setBooleanVarAt:put: (in category 'accessing - private') -----
+ setBooleanVarAt: index put: v
+ 
+ 	(v == true or: [v == false]) ifTrue: [
+ 		(PredicatedArray predicates: predicate values: (arrays at: index) type: #Boolean) atAllPut: (v == true ifTrue: [1] ifFalse: [0]).
+ 		^ self.
+ 	].
+ 	(PredicatedArray predicates: predicate values: (arrays at: index) type: #Boolean) replaceFrom: 1 to: v size with: v startingAt: 1.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>setColor: (in category 'player commands') -----
+ setColor: color
+ 
+ 	^ self color: color.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>setColorVarAt:put: (in category 'accessing - private') -----
+ setColorVarAt: index put: cPixel
+ 
+ 	cPixel isNumber ifTrue: [
+ 		(PredicatedArray predicates: predicate values: (arrays at: index) type: #Color) atAllPut: cPixel.
+ 		^ self.
+ 	].
+ 	cPixel isColor ifTrue: [
+ 		(PredicatedArray predicates: predicate values: (arrays at: index) type: #Color) atAllPut: (cPixel pixelValueForDepth: 32).
+ 		^ self.
+ 	].
+ 
+ 	(PredicatedArray predicates: predicate values: (arrays at: index) type: #Color) replaceFrom: 1 to: cPixel size with: cPixel startingAt: 1.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>setGreenComponentIn:to: (in category 'player commands') -----
+ setGreenComponentIn: aPatch to: value
+ 
+ 	| pix xArray yArray patch component |
+ 	xArray _ arrays at: 2.
+ 	yArray _ arrays at: 3.
+ 	patch _ aPatch costume renderedMorph.
+ 	value isCollection ifFalse: [
+ 		component _ (value asInteger bitAnd: 16rFF) bitShift: 8.
+ 	].
+ 	(1 to: self size) do: [:i |
+ 		(predicate at: i) = 1 ifTrue: [
+ 			value isCollection ifTrue: [
+ 				component _ ((value at: i) asInteger bitAnd: 16rFF) bitShift: 8.
+ 			].
+ 			pix _ patch pixelAtX: (xArray at: i) y: (yArray at: i).
+ 			pix _ (pix bitAnd: 16rFF00FF) bitOr: component.
+ 			patch pixelAtX: (xArray at: i) y: (yArray at: i) put: pix.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>setHeading: (in category 'player commands') -----
+ setHeading: degrees
+ 
+ 	^ self heading: degrees.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>setInitialValueOf:from:to:for: (in category 'player commands') -----
+ setInitialValueOf: name from: from to: to for: aKedamaWorld
+ 
+ 	| array max |
+ 	array _ arrays at: (info at: name).
+ 	name = #who ifTrue: [
+ 		from to: to do: [:index |
+ 			array at: index put: (aKedamaWorld nextTurtleID).
+ 		].
+ 		^ self.
+ 	].
+ 	name = #x ifTrue: [
+ 		max _ aKedamaWorld dimensions x * 100.
+ 		KedamaTurtleVectorPlayer2 randomRange: max from: from to: to intoFloatArray: array factor: 0.01 kedamaWorld: kedamaWorld.
+ 		^ self.
+ 	].
+ 	name = #y ifTrue: [
+ 		max _ aKedamaWorld dimensions y * 100.
+ 		KedamaTurtleVectorPlayer2 randomRange: max from: from to: to intoFloatArray: array factor: 0.01 kedamaWorld: kedamaWorld.
+ 		^ self.
+ 	].
+ 	name = #heading ifTrue: [
+ 		KedamaTurtleVectorPlayer2 randomRange: 36000 from: from to: to intoFloatArray: array factor: (0.01 *  0.0174532925199433) kedamaWorld: kedamaWorld.
+ 		^ self.
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>setNumberVarAt:put: (in category 'accessing - private') -----
+ setNumberVarAt: index put: v
+ 
+ 	v isNumber ifTrue: [
+ 		(PredicatedArray predicates: predicate values: (arrays at: index) type: #Number) atAllPut: v.
+ 		^ self.
+ 	].
+ 	(v isMemberOf: KedamaFloatArray) ifTrue: [
+ 		(PredicatedArray predicates: predicate values: (arrays at: index) type: #Number) replaceFrom: 1 to: v size with: v startingAt: 1.
+ 		^ self.
+ 	].
+ 	(v isMemberOf: WordArray) ifTrue: [
+ 		(PredicatedArray predicates: predicate values: (arrays at: index) type: #Number) 
+ 			replaceFrom: 1 to: v size with: v startingAt: 1.
+ 		^ self.
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>setObjectVarAt:put: (in category 'accessing - private') -----
+ setObjectVarAt: index put: v
+ 
+ 	(v isKindOf: Array) ifFalse: [
+ 		(PredicatedArray predicates: predicate values: (arrays at: index) type: #Object) atAllPut: v.
+ 		^ self.
+ 	].
+ 	(PredicatedArray predicates: predicate values: (arrays at: index) type: #Object) replaceFrom: 1 to: v size with: v startingAt: 1.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>setPatchValueIn:to: (in category 'player commands') -----
+ setPatchValueIn: aPatch to: value
+ 
+ 	| xArray yArray patchMorph |
+ 	xArray _ arrays at: 2.
+ 	yArray _ arrays at: 3.
+ 	patchMorph _ aPatch costume renderedMorph.
+ 	patchMorph setPixelsPredicates: predicate xArray: xArray yArray: yArray value: value.
+ 
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>setRedComponentIn:to: (in category 'player commands') -----
+ setRedComponentIn: aPatch to: value
+ 
+ 	| pix xArray yArray patch component |
+ 	xArray _ arrays at: 2.
+ 	yArray _ arrays at: 3.
+ 	patch _ aPatch costume renderedMorph.
+ 	value isCollection ifFalse: [
+ 		component _ (value asInteger bitAnd: 16rFF) bitShift: 16.
+ 	].
+ 	(1 to: self size) do: [:i |
+ 		(predicate at: i) = 1 ifTrue: [
+ 			value isCollection ifTrue: [
+ 				component _ ((value at: i) asInteger bitAnd: 16rFF) bitShift: 16.
+ 			].
+ 			pix _ patch pixelAtX: (xArray at: i) y: (yArray at: i).
+ 			pix _ (pix bitAnd: 16r00FFFF) bitOr: component.
+ 			patch pixelAtX: (xArray at: i) y: (yArray at: i) put: pix.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>setTurtleVisible: (in category 'player commands') -----
+ setTurtleVisible: aValue
+ 
+ 	| val |
+ 	aValue isCollection ifTrue: [
+ 		1 to: self size do: [:i |
+ 			(predicate at: i) = 1 ifTrue: [
+ 				(arrays at: 6) at: i put: ((aValue at: i) ifTrue: [1] ifFalse: [0]).
+ 			].
+ 		].
+ 	] ifFalse: [
+ 		val _ aValue ifTrue: [1] ifFalse: [0].
+ 		1 to: self size do: [:i |
+ 			(predicate at: i) = 1 ifTrue: [
+ 				(arrays at: 6) at: i put: (val).
+ 			].
+ 		].
+ 	].
+ 	kedamaWorld drawRequest.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>setTurtlesCount:prototype:for:randomize: (in category 'add turtles') -----
+ setTurtlesCount: count prototype: prototype for: aKedamaWorld randomize: rondomizeFlag
+ 
+ 	| anInteger array |
+ 	anInteger _ count.
+ 	count < 0 ifTrue: [anInteger _ 0].
+ 
+ 	self size > anInteger ifTrue: [
+ 		info associationsDo: [:assoc |
+ 			array _ (arrays at: assoc value).
+ 			array _ array copyFrom: 1 to: anInteger.
+ 			arrays at: assoc value put: array.
+ 		].
+ 		turtleMapValid _ false.
+ 		whoTableValid _ false.
+ 		predicate _ arrays at: 7.
+ 	].
+ 
+ 	self size < anInteger ifTrue: [
+ 		self addTurtlesCount: (anInteger - self size) ofPrototype: prototype for: aKedamaWorld randomize: rondomizeFlag.
+ 		turtleMapValid _ false.
+ 		whoTableValid _ false.
+ 
+ 	].
+ 	kedamaWorld drawRequest.
+ 
+ 
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>setVectorSlotTypeFor:typeChosen: (in category 'player protocol') -----
+ setVectorSlotTypeFor: slotName typeChosen: typeChosen
+ 
+ 	| index initVar |
+ 	index _ info at: slotName asSymbol.
+ 	index = 0 ifTrue: [^ self].
+ 
+ 	initVar _ self initialValueForSlotOfType: typeChosen.
+ 
+ 	types at: index put: typeChosen.
+ 
+ 	arrays at: index put: (self arrayForType: typeChosen).
+ 	self compileVectorInstVarAccessorsFor: slotName.
+ 	self perform: ('set', slotName capitalized, ':') asSymbol with: initVar.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>setX: (in category 'player commands') -----
+ setX: v
+ 
+ 	exampler getGrouped ifFalse: [
+ 		KedamaTurtleVectorPlayer2
+ 			primSetXPredicates: predicate
+ 			xArray: (arrays at: 2)
+ 			headingArray: (arrays at: 4)
+ 			value: (v isNumber ifTrue: [v asFloat] ifFalse: [v])
+ 			destWidth: kedamaWorld wrapX
+ 			leftEdgeMode: kedamaWorld leftEdgeModeMnemonic
+ 			rightEdgeMode: kedamaWorld rightEdgeModeMnemonic.
+ 	] ifTrue: [
+ 		self groupSetX: v
+ 	].
+ 	turtleMapValid _ false.
+ 	kedamaWorld drawRequest.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>setY: (in category 'player commands') -----
+ setY: v
+ 
+ 	exampler getGrouped ifFalse: [
+ 		KedamaTurtleVectorPlayer2
+ 			primSetYPredicates: predicate
+ 			yArray: (arrays at: 3)
+ 			headingArray: (arrays at: 4)
+ 			value: (v isNumber ifTrue: [v asFloat] ifFalse: [v])
+ 			destHeight: kedamaWorld wrapY
+ 			topEdgeMode: kedamaWorld topEdgeModeMnemonic
+ 			bottomEdgeMode: kedamaWorld bottomEdgeModeMnemonic.
+ 	] ifTrue: [
+ 		self groupSetY: v.
+ 	].
+ 	turtleMapValid _ false.
+ 	kedamaWorld drawRequest.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>show (in category 'player commands') -----
+ show
+ 
+ 	(arrays at: 6) atAllPut: 1.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>size (in category 'accessing') -----
+ size
+ 
+ 	^ arrays first size.
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>test:ifTrue:ifFalse: (in category 'command execution') -----
+ test: cond ifTrue: trueBlock ifFalse: falseBlock
+ 
+ 	| origPredicate c |
+ 	(cond == true or: [cond == false]) ifTrue: [
+ 		^ cond ifTrue: [trueBlock value: self] ifFalse: [falseBlock value: self].
+ 	].
+ 	origPredicate _ predicate clone.
+ 	predicate bytesAnd: cond.
+ 	trueBlock value: self.
+ 
+ 	c _ cond clone.
+ 	c not.
+ 	predicate replaceFrom: 1 to: (predicate size min: origPredicate size) with: origPredicate startingAt: 1.
+ 	predicate bytesAnd: c.
+ 	falseBlock value: self.
+ 	predicate replaceFrom: 1 to: (predicate size min: origPredicate size) with: origPredicate startingAt: 1.!

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>turn: (in category 'player commands') -----
+ turn: degrees
+ 	"Turn by the given number of degrees."
+ 
+ 	self heading: (self heading + degrees).
+ !

Item was added:
+ ----- Method: KedamaTurtleVectorPlayer2>>types (in category 'accessing') -----
+ types
+ 
+ 	^ types.
+ !

Item was added:
+ KedamaParseTreeRewriter subclass: #KedamaVectorParseTreeRewriter
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tweak-Kedama-ParseTreeTransformer'!

Item was added:
+ ----- Method: KedamaVectorParseTreeRewriter>>visit:andParent: (in category 'entry point') -----
+ visit: node andParent: parent
+ 
+ 	| newNode possibleSelector selIndex |
+ 	node isLeaf not ifTrue: [
+ 		node getAllChildren do: [:child |
+ 			self visit: child andParent: node.
+ 		].
+ 	].
+ 
+ 	(node rewriteInfoOut notNil) ifTrue: [
+ 		((node isMemberOf: VariableNode) or: [node isMemberOf: LiteralVariableNode]) ifTrue: [
+ 			newNode _ TempVariableNode new name: node rewriteInfoOut second index: 0 type: 2.
+ 			parent replaceNode: node with: newNode.
+ 		].
+ 
+ 	].
+ 
+ 	(node isMemberOf: MessageNode) ifTrue: [
+ 		(node statementType = #sequential) ifTrue: [
+ 			node selector key = #doSequentialCommand: ifTrue: [
+ 				(node isStatement) ifTrue: [
+ 					node receiver: node primaryBreedPair second.
+ 				].
+ 			]
+ 		].
+ 	].
+ 
+ 	(node isMemberOf: MessageNode) ifTrue: [
+ 		((selIndex _ #(parallel sequential die) indexOf: node statementType) > 0) ifTrue: [
+ 			possibleSelector _ #(doCommand: doSequentialCommand: doDieCommand:) at: selIndex.
+ 			(node messageType = #condition) ifTrue: [
+ 				newNode _ self createMessageNode: node inParentNode: parent receiverNode: (TempVariableNode new name: node rewriteInfoOut second index: 0 type: 2) selector: #test:ifTrue:ifFalse: arguments: (Array with: node receiver with: node arguments first with: node arguments second).
+ 				(node isStatement) ifFalse: [
+ 					parent replaceNode: node with: newNode.
+ 				] ifTrue: [
+ 					self rewriteMessageNode: node inParentNode: parent receiverNode: node rewriteInfoIn second selector: possibleSelector arguments: (Array with: (self makeBlockNodeArguments: (Array with: node rewriteInfoOut second) statements: (Array with: newNode) returns: false)).
+ 				].
+ 			] ifFalse: [
+ 				(node isStatement) ifTrue: [
+ 					self rewriteMessageNode: node inParentNode: parent receiverNode: node rewriteInfoIn second selector: possibleSelector arguments: (Array with: (self makeBlockNodeArguments: (Array with: node rewriteInfoOut second) statements: (Array with: node) returns: false)).
+ 				].
+ 			]
+ 		].
+ 	].
+ 
+ 	(node isMemberOf: BlockNode) ifTrue: [
+ 		(node rewriteInfoOut notNil) ifTrue: [
+ 			self rewriteBlockNode: node inParentNode: parent arguments: (Array with: (TempVariableNode new name: node rewriteInfoOut second index: 0 type: 2)) statements: node statements returns: false.
+ 		].
+ 	].
+ 
+ !

Item was added:
+ Morph subclass: #KeyPressMorph
+ 	instanceVariableNames: 'currentKey lastTimePressed isWaitingToSetCurrentKey'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Input'!

Item was added:
+ ----- Method: KeyPressMorph class>>additionsToViewerCategories (in category 'viewer categories') -----
+ additionsToViewerCategories
+ ^ #(
+ (#input (
+ #(slot currentKey 'The current key' String readOnly Player getCurrentKey Player unused)
+ #(slot keyIsPressed 'Whether the current key is pressed at the moment' Boolean readOnly Player getKeyIsPressed Player unused)
+ #(slot timePressed 'The time in milliseconds the current key has been pressed' Number readOnly Player getTimePressed Player unused)
+ )))!

Item was added:
+ ----- Method: KeyPressMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self
+ 		partName: 'Key press' translatedNoop
+ 		categories: {'Just for Fun' translatedNoop}
+ 		documentation: 'An object that tells you when a specific key has been pressed.' translatedNoop
+ !

Item was added:
+ ----- Method: KeyPressMorph>>changeCurrentKey (in category 'actions') -----
+ changeCurrentKey
+ 	isWaitingToSetCurrentKey
+ 		ifTrue: [self setCurrentKey: currentKey]
+ 		ifFalse: [self say: 'Press new key' translated;
+ 					color: Color red muchLighter.
+ 			isWaitingToSetCurrentKey := true]!

Item was added:
+ ----- Method: KeyPressMorph>>currentKey (in category 'accessing') -----
+ currentKey
+ 	^ currentKey!

Item was added:
+ ----- Method: KeyPressMorph>>handleKeyboardEvent: (in category 'events') -----
+ handleKeyboardEvent: anEvent
+ 	isWaitingToSetCurrentKey
+ 		ifTrue: [self setCurrentKey: anEvent keyString asLowercase]
+ 		ifFalse: [self setIsPressed: anEvent]
+ !

Item was added:
+ ----- Method: KeyPressMorph>>handleListenEvent: (in category 'events') -----
+ handleListenEvent: anEvent
+ 	anEvent isMouse
+ 		ifTrue: [self handleMouseEvent: anEvent]
+ 		ifFalse: [self handleKeyboardEvent: anEvent]!

Item was added:
+ ----- Method: KeyPressMorph>>handleMouseEvent: (in category 'events') -----
+ handleMouseEvent: anEvent
+ 	(isWaitingToSetCurrentKey and: [anEvent type = #mouseUp])
+ 		ifTrue: [self setCurrentKey: self currentKey]!

Item was added:
+ ----- Method: KeyPressMorph>>initialize (in category 'initialize') -----
+ initialize
+ 	super initialize.
+ 	currentKey := 'a'.
+ 	isWaitingToSetCurrentKey := false.	
+ 	self layoutPolicy: TableLayout new;
+ 		listDirection: #topToBottom;
+ 	 	wrapCentering: #topLeft;
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #shrinkWrap;
+ 		layoutInset: 5;
+ 		color: Color blue muchLighter;
+ 		borderColor: Color blue;
+ 		cornerStyle: #rounded;
+ 		rebuild
+ !

Item was added:
+ ----- Method: KeyPressMorph>>intoWorld: (in category 'events') -----
+ intoWorld: aWorld
+ 	super intoWorld: aWorld.
+ 	self registerToEvents.
+ !

Item was added:
+ ----- Method: KeyPressMorph>>isPressed (in category 'accessing') -----
+ isPressed
+ 	^ self timePressed > 0!

Item was added:
+ ----- Method: KeyPressMorph>>outOfWorld: (in category 'events') -----
+ outOfWorld: aWorld
+ 	self unregisterToEvents.
+ 	super outOfWorld: aWorld.
+ !

Item was added:
+ ----- Method: KeyPressMorph>>rebuild (in category 'building') -----
+ rebuild
+ 	| keyButton |
+ 	self removeAllMorphs.
+ 	self addMorphBack: 'Key:' translated asMorph.
+ 	self addMorphBack: (keyButton := SimpleButtonMorph new
+ 								labelString: self currentKey;
+ 								color: Color white;
+ 								target: self;
+ 								actionSelector: #changeCurrentKey;
+ 								yourself).
+ 	keyButton width < 50
+ 		ifTrue: [keyButton width: 50]!

Item was added:
+ ----- Method: KeyPressMorph>>registerToEvents (in category 'events') -----
+ registerToEvents
+ 	self currentHand
+ 		addKeyboardListener: self;
+ 		addMouseListener: self!

Item was added:
+ ----- Method: KeyPressMorph>>setCurrentKey: (in category 'events') -----
+ setCurrentKey: aString
+ 	isWaitingToSetCurrentKey := false.
+ 	self stopSayingOrThinking;
+ 		color: Color blue muchLighter.
+ 	currentKey := aString.
+ 	self rebuild!

Item was added:
+ ----- Method: KeyPressMorph>>setIsPressed: (in category 'events') -----
+ setIsPressed: anEvent 
+ 	anEvent keyString asLowercase = self currentKey asLowercase
+ 		ifFalse: [^ self].
+ 	anEvent type caseOf: {
+ 		[#keyDown] -> [self isPressed ifTrue: [^ self].
+ 				lastTimePressed := Time millisecondClockValue].
+ 		[#keyUp] -> [lastTimePressed := nil]
+ 	} otherwise: [].
+ 	lastTimePressed notNil
+ 		ifTrue: [self borderWidth: 2]
+ 		ifFalse: [self borderWidth: 0]
+ !

Item was added:
+ ----- Method: KeyPressMorph>>timePressed (in category 'accessing') -----
+ timePressed
+ 	^ lastTimePressed
+ 			ifNil: [0]
+ 			ifNotNil: [:last | Time millisecondsSince: last]!

Item was added:
+ ----- Method: KeyPressMorph>>unregisterToEvents (in category 'events') -----
+ unregisterToEvents
+ 	self currentHand
+ 		removeKeyboardListener: self;
+ 		removeMouseListener: self!

Item was added:
+ ----- Method: KeyboardEvent>>addKeystrokeEventsTo: (in category '*Etoys-Squeakland-debugging') -----
+ addKeystrokeEventsTo: aStream
+ 	"Add any keystroke event to a stream"
+ 
+ 	type = #keystroke ifTrue: [aStream nextPut: self]
+ 
+ 	!

Item was added:
+ ----- Method: KeyboardEvent>>keyValue: (in category '*Etoys-Squeakland-initialize') -----
+ keyValue: aValue
+ 	"Directly set the keyValue.  Used by event-recording mechanisms."
+ 
+ 	keyValue := aValue!

Item was added:
+ EventMorph subclass: #KeyboardEventMorph
+ 	instanceVariableNames: 'character'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !KeyboardEventMorph commentStamp: 'sw 12/21/2006 22:31' prior: 0!
+ A morph representing a keyboard event.!

Item was added:
+ ----- Method: KeyboardEventMorph>>addCustomMenuItems:hand: (in category 'menu commands') -----
+ addCustomMenuItems: aCustomMenu hand: aHandMorph
+ 	"Add morph-specific items to the given menu which was invoked by the given hand.  This method provides is invoked both from the halo-menu and from the control-menu regimes."
+ 
+ 	aCustomMenu add: 'Change character' translated target: self action: #changeCharacter!

Item was added:
+ ----- Method: KeyboardEventMorph>>changeCharacter (in category 'menu commands') -----
+ changeCharacter
+ 	"Allow the user to select a new character for the receiver."
+ 
+ 	| result |
+ 	result := FillInTheBlank request: 'New character? ' translated initialAnswer: character asString.
+ 	result isEmptyOrNil ifTrue: [^ self].
+ 	result = character asString ifTrue: [^ self].
+ 	event keyValue: result first asciiValue.
+ 	self eventRoll ifNotNilDo: [:r | r pushChangesBackToEventTheatre]!

Item was added:
+ ----- Method: KeyboardEventMorph>>character (in category 'accessing') -----
+ character
+ 	"Answer the value of character"
+ 
+ 	^ character!

Item was added:
+ ----- Method: KeyboardEventMorph>>character: (in category 'accessing') -----
+ character: c
+ 	"Set the character"
+ 
+ 	| aColor |
+ 	character := c.
+ 	aColor := c = Character space
+ 		ifTrue:
+ 			[Color yellow lighter]
+ 		ifFalse:
+ 			[c = Character backspace
+ 				ifTrue:
+ 					[Color blue lighter]
+ 				ifFalse: 
+ 					[(c tokenish or: [c isSpecial])
+ 						ifTrue:
+ 							[self colorFromEvent]
+ 						ifFalse:
+ 							[Color red lighter]]].
+ 	self color: aColor!

Item was added:
+ ----- Method: KeyboardEventMorph>>colorFromEvent (in category 'initialization') -----
+ colorFromEvent
+ 	"Answer a color corresponding to my event"
+ 
+ 	| aColor |
+ 	aColor := Color white.
+ 	event shiftPressed ifTrue:
+ 		[aColor := aColor mixed: 0.3 with: Color red].
+ 	event commandKeyPressed ifTrue:
+ 		[aColor := aColor mixed: 0.3 with: Color green].
+ 	event controlKeyPressed ifTrue:
+ 		[aColor := aColor mixed: 0.3 with: Color yellow].
+ 	^ aColor!

Item was added:
+ ----- Method: KeyboardEventMorph>>event: (in category 'initialization') -----
+ event: anObject
+ 	"Set the value of event"
+ 
+ 	event := anObject.
+ 	self setColorFromEvent!

Item was added:
+ ----- Method: KeyboardEventMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialze the receiver."
+ 
+ 	super initialize.
+ 	self color: (Color r: 0.0 g: 0.968 b: 0.903)!

Item was added:
+ ----- Method: KeyboardEventMorph>>setColorFromEvent (in category 'initialization') -----
+ setColorFromEvent
+ 	"Set the receiver's color from the info in the event."
+ 
+ 	self color: self colorFromEvent!

Item was added:
+ EventSequence subclass: #KeyboardEventSequence
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !KeyboardEventSequence commentStamp: 'sw 12/21/2006 22:34' prior: 0!
+ An event sequence consisting of a related series of keyboard events, from a key-down through a key-up.  This is not in current use, since the reporting of keyboard events seems so erratic that we are only gathering keystroke events for the time being.!

Item was added:
+ ----- Method: KeyboardEventSequence>>addKeystrokeEventsTo: (in category 'debugging') -----
+ addKeystrokeEventsTo: aStream
+ 	"Add any keystroke event to a stream"
+ 
+ 	events do: [:e | e eventType = #keystroke ifTrue:
+ 		[aStream nextPut: e]]!

Item was added:
+ ----- Method: KeyboardEventSequence>>printOn: (in category 'debugging') -----
+ printOn: aStream
+ 	"Print the receiver on a stream"
+ 
+ 	aStream nextPutAll: self class name, ': duration: ', (self duration printString), 'ms  ', events first type,'$', events first keyValue asCharacter asString, ' -> ', events last type, ' total events ', (events size printString)!

Item was added:
+ ----- Method: KeyboardEventSequence>>type (in category 'debugging') -----
+ type
+ 	"Return a symbol indicating the type this event."
+ 
+ 	^ #keystroke!

Item was added:
+ ----- Method: KeyboardInputInterpreter>>keycodeFor: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ keycodeFor: anInteger
+ 	"interpret the key from an up/down event, if necessary"
+ 	^ anInteger!

Item was added:
+ ----- Method: KeyboardMorphForInput>>numberOfKeys (in category '*Etoys-Squeakland-private') -----
+ numberOfKeys
+ 	"Answer the number of keys the receiver has.  If, in grandfathered content, the numberOfKeys instance var is not set, compute it at this time."
+ 
+ 	| firstPast |
+ 	^ numberOfKeys ifNil:
+ 		[firstPast := submorphs detect: [:m | m isAlignmentMorph] ifNone: [nil].
+ 		numberOfKeys := firstPast
+ 			ifNil:
+ 				[submorphs size]
+ 			ifNotNil:
+ 				[(submorphs indexOf: firstPast) - 1]]!

Item was added:
+ ----- Method: KeyboardMorphForInput>>stopAllSound (in category '*Etoys-Squeakland-private') -----
+ stopAllSound
+ 	"Stop all sounds associated with any of my keys."
+ 
+ 	1 to: self numberOfKeys do: [:i |
+ 		self stopSoundAt: i]
+ !

Item was added:
+ ProjectNavigationMorph subclass: #KidNavigationMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'PreExistingProjects'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Navigators'!

Item was added:
+ ----- Method: KidNavigationMorph>>addButtons (in category 'as yet unclassified') -----
+ addButtons
+ 
+ 	(self addARow: {
+ 
+ 		self inAColumn: {self buttonFind}.
+ 		self transparentSpacerOfSize:6 at 6.
+ 		self transparentSpacerOfSize:6 at 6.
+ 		self inAColumn: {self buttonNewProject}.
+ 	}) layoutInset: 6.
+ 	self addARow: {
+ 		self transparentSpacerOfSize:0 at 6.
+ 	}.
+ 	(self addARow: {
+ 		self inAColumn: {self buttonPublish}.
+ 	}) layoutInset: 6.
+ 	self addARow: {
+ 		self transparentSpacerOfSize:0 at 18.
+ 	}.
+ 	(self addARow: {
+ 		self inAColumn: {self buttonQuit}.
+ 	}) layoutInset: 6.
+ 
+ !

Item was added:
+ ----- Method: KidNavigationMorph>>amountToShowWhenSmall (in category 'as yet unclassified') -----
+ amountToShowWhenSmall
+ 	^49!

Item was added:
+ ----- Method: KidNavigationMorph>>balloonText (in category 'accessing') -----
+ balloonText
+ 	^ ((mouseInside
+ 			ifNil: [false])
+ 		ifTrue: ['Click here to see FEWER buttons.']
+ 		ifFalse: ['Click here to see MORE buttons.'])  translated!

Item was added:
+ ----- Method: KidNavigationMorph>>colorForButtons (in category 'as yet unclassified') -----
+ colorForButtons
+ 
+ 	^Color r: 0.613 g: 0.71 b: 1.0 !

Item was added:
+ ----- Method: KidNavigationMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	| result |
+ 	result _ GradientFillStyle ramp: {0.0
+ 					-> (Color
+ 							r: 0.032
+ 							g: 0.0
+ 							b: 0.484). 1.0
+ 					-> (Color
+ 							r: 0.194
+ 							g: 0.032
+ 							b: 1.0)}.
+ 	result origin: self bounds topLeft.
+ 	result direction: 0 @ 200.
+ 	result radial: false.
+ 	^ result!

Item was added:
+ ----- Method: KidNavigationMorph>>fontForButtons (in category 'as yet unclassified') -----
+ fontForButtons
+ 
+ 	^Preferences standardEToysFont!

Item was added:
+ ----- Method: KidNavigationMorph>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: evt
+ 
+ 	^true
+ 	!

Item was added:
+ ----- Method: KidNavigationMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	| |
+ 	super initialize.
+ 	""
+ 	self layoutInset: 12.
+ 
+ 	self removeAllMorphs.
+ 	self addButtons!

Item was added:
+ ----- Method: KidNavigationMorph>>mouseEnter: (in category 'event handling') -----
+ mouseEnter: evt
+ 
+ 	"kid nav doesn't care"
+ 	!

Item was added:
+ ----- Method: KidNavigationMorph>>mouseLeave: (in category 'event handling') -----
+ mouseLeave: evt
+ 
+ 	"kid nav doesn't care"
+ 	!

Item was added:
+ ----- Method: KidNavigationMorph>>mouseUp: (in category 'event handling') -----
+ mouseUp: evt
+ 
+ 	mouseInside _ (mouseInside ifNil: [false]) not.
+ 	self positionVertically
+ 	!

Item was added:
+ ----- Method: KidNavigationMorph>>quitSqueak (in category 'the actions') -----
+ quitSqueak
+ 
+ 	| newProjects limit now msg response |
+ 
+ 	Preferences checkForUnsavedProjects ifFalse: [^super quitSqueak].
+ 	PreExistingProjects ifNil: [^super quitSqueak].
+ 	limit _ 5 * 60.
+ 	now _ Time totalSeconds.
+ 	newProjects _ Project allProjects reject: [ :each | PreExistingProjects includes: each].
+ 	newProjects _ newProjects reject: [ :each | 
+ 		((each lastSavedAtSeconds ifNil: [0]) - now) abs < limit
+ 	].
+ 	newProjects isEmpty ifTrue: [^super quitSqueak].
+ 	msg _ String streamContents: [ :strm |
+ 		strm nextPutAll: 'There are some project(s)
+ that have not been saved recently:
+ ----
+ '.
+ 		newProjects do: [ :each | strm nextPutAll: each name; cr].
+ 		strm nextPutAll: '----
+ What would you like to do?'
+ 	].
+ 	response _ PopUpMenu 
+ 		confirm: msg
+ 		trueChoice: 'Go ahead and QUIT'
+ 		falseChoice: 'Wait, let me save them first'.
+ 	response ifTrue: [^super quitSqueak].
+ 
+ !

Item was added:
+ ----- Method: KidNavigationMorph>>step (in category 'stepping and presenter') -----
+ step
+ 
+ 	super step.
+ 	PreExistingProjects ifNil: [PreExistingProjects _ WeakArray withAll: Project allProjects].!

Item was added:
+ ----- Method: LanguageEnvironment class>>scanSelector (in category '*Etoys-Squeakland-language methods') -----
+ scanSelector
+ 
+ 	^ #scanMultiCharactersFrom:to:in:rightX:stopConditions:kern:
+ !

Item was added:
+ ----- Method: LanguageEnvironment class>>setUsePangoFlag (in category '*Etoys-Squeakland-private') -----
+ setUsePangoFlag
+ 
+ 	| new old |
+ 	old := Preferences usePangoRenderer.
+ 	new := RomePluginCanvas pangoIsAvailable and: [Locale current languageEnvironment class usePangoRenderer].
+ 	(old not and: [new]) ifTrue: [
+ 		Preferences setPreference: #usePangoRenderer toValue: new.
+ 		TextMorph usePango: new.
+ 	].!

Item was added:
+ ----- Method: LanguageEnvironment class>>usePangoRenderer (in category '*Etoys-Squeakland-private') -----
+ usePangoRenderer
+ 
+ 	| tr font phraseTest fontName |
+ 	Preferences usePangoRenderer ifTrue: [^ true].
+ 
+ 	"first, see if people specified font." 
+ 	tr := NaturalLanguageTranslator current.
+ 	fontName := tr translate: 'Linux-Font'.
+ 	(fontName ~= 'Linux-Font'
+ 			and: [(StrikeFont familyNames includes: fontName asSymbol) not]) ifTrue: [^ true].
+ 
+ 	font := TextStyle defaultFont.
+ 	phraseTest := [:phrase |
+ 		phrase  do: [:c |
+ 			(font hasGlyphWithFallbackOf: c) ifFalse: [^ true]]].
+ 
+ 	"Hopefully people start translating phrases that are really used, but also people translate on the Pootle server which has a ideosyncratic ordering..."
+ 	#('Rectangle' 'Text' 'forward by' 'turn by' 'color' 'choose new graphic' 'linear gradient' 'open as Flash' 'set custom action' 'show compressed size' 'more smoothing') do: [:ph | phraseTest value: (tr translate: ph)].
+ 
+ 	"But it is not often the case; so a bit more testing..."
+ 	10 timesRepeat: [
+ 		phraseTest value: tr atRandom].
+ 
+ 	^ false.
+ !

Item was added:
+ ----- Method: LassoPatchMorph>>justTornOffFromPartsBin (in category '*Etoys-Squeakland-initialization') -----
+ justTornOffFromPartsBin
+ 	super justTornOffFromPartsBin.
+ 	self image: (Form extent: 0 @ 0).	"hide the icon"
+ 	ActiveHand showTemporaryCursor: Cursor crossHair!

Item was added:
+ ----- Method: LeafNode>>defaultBlockType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultBlockType: t1 
+ 	^ #default!

Item was added:
+ ----- Method: LeafNode>>defaultMessageType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultMessageType
+ 	^ #none!

Item was added:
+ ----- Method: LeafNode>>emitForEffect:on: (in category '*Etoys-Squeakland-code generation') -----
+ emitForEffect: stack on: strm
+ 
+ 	^self!

Item was added:
+ ----- Method: LeafNode>>firstInReceivers: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ firstInReceivers: t1 
+ 	^ t1 first!

Item was added:
+ ----- Method: LeafNode>>initialNil (in category '*Etoys-Tweak-Kedama-Generated') -----
+ initialNil
+ 	^ nil!

Item was added:
+ ----- Method: LeafNode>>isLeaf (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isLeaf
+ 
+ 	^ true.
+ !

Item was added:
+ ----- Method: LeafNode>>isStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isStmt: t1 
+ 	^ t1 = #top
+ 		or: [t1 = #condition]!

Item was added:
+ ----- Method: LeafNode>>isTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTest: t1 parentNode: t2 
+ 	t1 = true
+ 		ifTrue: [^ true].
+ 	^ (t2 isMemberOf: MessageNode)
+ 		and: [t2 receiver = self
+ 				and: [t2 messageType value = #condition]]!

Item was added:
+ ----- Method: LeafNode>>isTopStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmt: t1 
+ 	t1 = nil
+ 		ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: LeafNode>>key: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ key: anObject
+ 
+ 	key _ anObject.
+ !

Item was added:
+ ----- Method: LeafNode>>name:key:index:type: (in category '*Etoys-Squeakland-initialize-release') -----
+ name: literal key: object index: i type: type
+ 
+ 	self key: object
+ 		index: i
+ 		type: type!

Item was added:
+ ----- Method: LeafNode>>rcvr: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr: t1 
+ 	^ t1!

Item was added:
+ ----- Method: LeafNode>>replaceNode:with: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ replaceNode: childNode with: newNode
+ 
+ 	childNode = key ifTrue: [key _ newNode].
+ !

Item was added:
+ ----- Method: LeafNode>>sizeForEffect: (in category '*Etoys-Squeakland-code generation') -----
+ sizeForEffect: encoder
+ 
+ 	^0!

Item was added:
+ ----- Method: LeafNode>>thisNode (in category '*Etoys-Tweak-Kedama-Generated') -----
+ thisNode
+ 	^ self!

Item was added:
+ ----- Method: LeafNode>>transfer: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 
+ 	^ t1!

Item was added:
+ ----- Method: LeafNode>>visitBy: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ visitBy: visitor
+ 
+ 	visitor visit: self.
+ !

Item was added:
+ Object subclass: #LineIntersectionEvent
+ 	instanceVariableNames: 'position type segment crossedEdge'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Graphics-Tools-Intersection'!
+ 
+ !LineIntersectionEvent commentStamp: '<historical>' prior: 0!
+ I represent an event that occurs during the computation of line segment intersections.
+ 
+ Instance variables:
+ 	position		<Point>	The position of where this event occurs
+ 	type		<Symbol>	The type of the event
+ 	edge		<LineIntersectionSegment>	The edge associated with this event.
+ 	crossedEdge	<LineIntersectionSegment>	The crossing edge of a #cross event.!

Item was added:
+ ----- Method: LineIntersectionEvent class>>type:position:segment: (in category 'instance creation') -----
+ type: aSymbol position: aPoint segment: aSegment
+ 	^self new type: aSymbol position: aPoint segment: aSegment!

Item was added:
+ ----- Method: LineIntersectionEvent>>crossedEdge (in category 'accessing') -----
+ crossedEdge
+ 	^crossedEdge!

Item was added:
+ ----- Method: LineIntersectionEvent>>crossedEdge: (in category 'accessing') -----
+ crossedEdge: aSegment
+ 	crossedEdge _ aSegment!

Item was added:
+ ----- Method: LineIntersectionEvent>>edge (in category 'accessing') -----
+ edge
+ 	^segment!

Item was added:
+ ----- Method: LineIntersectionEvent>>position (in category 'accessing') -----
+ position
+ 	^position!

Item was added:
+ ----- Method: LineIntersectionEvent>>priority (in category 'accessing') -----
+ priority
+ 	"Return the priority for this event"
+ 	type == #start ifTrue:[^3]. "first insert new segments"
+ 	type == #cross ifTrue:[^2]. "then process intersections"
+ 	type == #end ifTrue:[^1]. "then remove edges"
+ 	^self error:'Unknown type'!

Item was added:
+ ----- Method: LineIntersectionEvent>>segment (in category 'accessing') -----
+ segment
+ 	^segment!

Item was added:
+ ----- Method: LineIntersectionEvent>>sortsBefore: (in category 'sorting') -----
+ sortsBefore: anEvent
+ 	(self position x = anEvent position x and:[self position y = anEvent position y])
+ 		ifFalse:[^self position sortsBefore: anEvent position].
+ 	^self priority > anEvent priority!

Item was added:
+ ----- Method: LineIntersectionEvent>>type (in category 'accessing') -----
+ type
+ 	^type!

Item was added:
+ ----- Method: LineIntersectionEvent>>type:position:segment: (in category 'initialize-release') -----
+ type: aSymbol position: aPoint segment: aSegment
+ 	type _ aSymbol.
+ 	position _ aPoint.
+ 	segment _ aSegment.!

Item was added:
+ LineSegment subclass: #LineIntersectionSegment
+ 	instanceVariableNames: 'referentEdge'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Graphics-Tools-Intersection'!
+ 
+ !LineIntersectionSegment commentStamp: '<historical>' prior: 0!
+ I represent a line segment used during the computation of intersections.
+ 
+ Instance variables:
+ 	referentEdge	<LineSegment>	The line segment this segment originated from.
+ !

Item was added:
+ ----- Method: LineIntersectionSegment>>referentEdge (in category 'accessing') -----
+ referentEdge
+ 	^referentEdge!

Item was added:
+ ----- Method: LineIntersectionSegment>>referentEdge: (in category 'accessing') -----
+ referentEdge: anEdge
+ 	referentEdge _ anEdge!

Item was added:
+ Object subclass: #LineIntersections
+ 	instanceVariableNames: 'segments activeEdges events intersections lastIntersections'
+ 	classVariableNames: 'Debug'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Graphics-Tools-Intersection'!
+ 
+ !LineIntersections commentStamp: '<historical>' prior: 0!
+ This class computes all intersections of a set of line segments. The input segments must be integer coordinates. The intersections returned will be accurate, meaning that fractional points describing the intersections will be reported. It is up to the client to convert these fractional points if required.!

Item was added:
+ ----- Method: LineIntersections class>>debugMode (in category 'debug') -----
+ debugMode
+ 	^Debug == true!

Item was added:
+ ----- Method: LineIntersections class>>debugMode: (in category 'debug') -----
+ debugMode: aBool
+ 	"LineIntersections debugMode: true"
+ 	"LineIntersections debugMode: false"
+ 	Debug _ aBool.!

Item was added:
+ ----- Method: LineIntersections class>>exampleLines: (in category 'example') -----
+ exampleLines: n
+ 	"LineIntersections exampleLines: 100"
+ 	| segments rnd canvas intersections pt p1 p2 |
+ 	rnd _ Random new.
+ 	segments _ (1 to: n) collect:[:i|
+ 		p1 _ (rnd next @ rnd next * 500) asIntegerPoint.
+ 		[p2 _ (rnd next @ rnd next * 200 - 100) asIntegerPoint.
+ 		p2 isZero] whileTrue.
+ 		LineSegment from: p1 to: p1 + p2].
+ 	canvas _ Display getCanvas.
+ 	canvas fillRectangle: (0 at 0 extent: 600 at 600) color: Color white.
+ 	segments do:[:seg|
+ 		canvas line: seg start to: seg end width: 1 color: Color black.
+ 	].
+ 	intersections _ LineIntersections of: segments.
+ 	intersections do:[:array|
+ 		pt _ array at: 1.
+ 		canvas fillRectangle: (pt asIntegerPoint - 2 extent: 5 at 5) color: Color red].
+ 	Display restoreAfter:[].!

Item was added:
+ ----- Method: LineIntersections class>>of: (in category 'instance creation') -----
+ of: anArrayOfLineSegments
+ 	^self new computeIntersectionsOf: anArrayOfLineSegments!

Item was added:
+ ----- Method: LineIntersections class>>regularize: (in category 'instance creation') -----
+ regularize: pointCollection
+ 	"Make the pointList non-intersecting, e.g., insert points at intersections and have the outline include those points"
+ 	| pointList segments last intersections map pts |
+ 	pointList _ pointCollection collect:[:pt| pt asIntegerPoint].
+ 	segments _ WriteStream on: (Array new: pointList size).
+ 	last _ pointList last.
+ 	pointList do:[:next|
+ 		segments nextPut: (LineSegment from: last to: next).
+ 		last _ next.
+ 	].
+ 	segments _ segments contents.
+ 	intersections _ self of: segments.
+ 	map _ IdentityDictionary new: segments size.
+ 	intersections do:[:is|
+ 		(map at: is second ifAbsentPut:[WriteStream on: (Array new: 2)]) nextPut: is first.
+ 		(map at: is third ifAbsentPut:[WriteStream on: (Array new: 2)]) nextPut: is first.
+ 	].
+ 	pts _ WriteStream on: (Array new: pointList size).
+ 	segments do:[:seg|
+ 		intersections _ (map at: seg) contents.
+ 		intersections _ intersections sort:
+ 			[:p1 :p2|  (p1 squaredDistanceTo: seg start) <= (p2 squaredDistanceTo: seg start)].
+ 		last _ intersections at: 1.
+ 		pts nextPut: last.
+ 		intersections do:[:next|
+ 			(next = last and:[next = seg end]) ifFalse:[
+ 				pts nextPut: next.
+ 				last _ next]].
+ 	].
+ 	^pts contents collect:[:pt| pt asFloatPoint]!

Item was added:
+ ----- Method: LineIntersections>>computeIntersectionAt:belowOrRightOf: (in category 'computing') -----
+ computeIntersectionAt: leftIndex belowOrRightOf: aPoint
+ 	| leftEdge rightEdge pt evt |
+ 	leftIndex < 1 ifTrue:[^self].
+ 	leftIndex >= activeEdges size ifTrue:[^self].
+ 	leftEdge _ activeEdges at: leftIndex.
+ 	rightEdge _ activeEdges at: leftIndex+1.
+ 	Debug == true ifTrue:[
+ 		self debugDrawLine: leftEdge with: rightEdge color: Color yellow.
+ 		self debugDrawLine: leftEdge with: rightEdge color: Color blue.
+ 		self debugDrawLine: leftEdge with: rightEdge color: Color yellow.
+ 		self debugDrawLine: leftEdge with: rightEdge color: Color blue.
+ 	].
+ 	pt _ self intersectFrom: leftEdge start to: leftEdge end with: rightEdge start to: rightEdge end.
+ 	pt ifNil:[^self].
+ 	pt y < aPoint y ifTrue:[^self].
+ 	(pt y = aPoint y and:[pt x <= aPoint x]) ifTrue:[^self].
+ 	Debug == true ifTrue:[self debugDrawPoint: pt].
+ 	evt _ LineIntersectionEvent type: #cross position: pt segment: leftEdge.
+ 	evt crossedEdge: rightEdge.
+ 	events add: evt.!

Item was added:
+ ----- Method: LineIntersections>>computeIntersectionsOf: (in category 'computing') -----
+ computeIntersectionsOf: anArrayOfLineSegments
+ 	segments _ anArrayOfLineSegments.
+ 	self initializeEvents.
+ 	self processEvents.
+ 	^intersections contents!

Item was added:
+ ----- Method: LineIntersections>>crossEdgeEvent: (in category 'computing') -----
+ crossEdgeEvent: evt
+ 	| evtPoint edge index other |
+ 	lastIntersections 
+ 		ifNil:[lastIntersections _ Array with: evt]
+ 		ifNotNil:[
+ 			(lastIntersections anySatisfy:
+ 				[:old| old edge == evt edge and:[old crossedEdge == evt crossedEdge]]) ifTrue:[^self].
+ 			lastIntersections _ lastIntersections copyWith: evt].
+ 	evtPoint _ evt position.
+ 	edge _ evt edge.
+ 	self recordIntersection: edge with: evt crossedEdge at: evtPoint.
+ 	Debug == true ifTrue:[
+ 		self debugDrawLine: edge with: evt crossedEdge color: Color red.
+ 		self debugDrawLine: edge with: evt crossedEdge color: Color blue.
+ 		self debugDrawLine: edge with: evt crossedEdge color: Color red.
+ 		self debugDrawLine: edge with: evt crossedEdge color: Color blue].
+ 	index _ self firstIndexForInserting: evtPoint.
+ 	[other _ activeEdges at: index.
+ 	other == edge] whileFalse:[index _ index + 1].
+ 	"Swap edges at index"
+ 	"self assert:[(activeEdges at: index+1) == evt crossedEdge]."
+ 	other _ activeEdges at: index+1.
+ 	activeEdges at: index+1 put: edge.
+ 	activeEdges at: index put: other.
+ 	"And compute new intersections"
+ 	self computeIntersectionAt: index-1 belowOrRightOf: evtPoint.
+ 	self computeIntersectionAt: index+1 belowOrRightOf: evtPoint.!

Item was added:
+ ----- Method: LineIntersections>>debugDrawLine:color: (in category 'debug') -----
+ debugDrawLine: line color: aColor
+ 	Display getCanvas
+ 		line: (line start * self debugScale)
+ 		to: (line end * self debugScale)
+ 		width: 3
+ 		color: aColor.
+ 	self debugWait.!

Item was added:
+ ----- Method: LineIntersections>>debugDrawLine:with:color: (in category 'debug') -----
+ debugDrawLine: line1 with: line2 color: aColor
+ 	Display getCanvas
+ 		line: (line1 start * self debugScale)
+ 		to: (line1 end * self debugScale)
+ 		width: 3
+ 		color: aColor.
+ 	Display getCanvas
+ 		line: (line2 start * self debugScale)
+ 		to: (line2 end * self debugScale)
+ 		width: 3
+ 		color: aColor.
+ 	self debugWait.!

Item was added:
+ ----- Method: LineIntersections>>debugDrawPoint: (in category 'debug') -----
+ debugDrawPoint: pt
+ 	Display getCanvas
+ 		fillRectangle: (pt * self debugScale - 3 extent: 6 at 6) truncated color: Color red.
+ 	self debugWait.!

Item was added:
+ ----- Method: LineIntersections>>debugScale (in category 'debug') -----
+ debugScale
+ 	^1!

Item was added:
+ ----- Method: LineIntersections>>debugWait (in category 'debug') -----
+ debugWait
+ 	(Delay forMilliseconds: 100) wait.!

Item was added:
+ ----- Method: LineIntersections>>endEdgeEvent: (in category 'computing') -----
+ endEdgeEvent: evt
+ 	| evtPoint edge index other |
+ 	evtPoint _ evt position.
+ 	edge _ evt edge.
+ 	Debug == true ifTrue:[self debugDrawLine: edge color: Color green].
+ 	index _ self firstIndexForInserting: evtPoint.
+ 	[other _ activeEdges at: index.
+ 	other == edge] whileFalse:[index _ index + 1].
+ 	"Remove edge at index"
+ 	activeEdges removeAt: index.
+ 	self computeIntersectionAt: index-1 belowOrRightOf: evtPoint.!

Item was added:
+ ----- Method: LineIntersections>>firstIndexForInserting: (in category 'private') -----
+ firstIndexForInserting: aPoint
+ 	| index |
+ 	index _ self indexForInserting: aPoint.
+ 	[index > 1 and:[((activeEdges at: index-1) sideOfPoint: aPoint) = 0]]
+ 		whileTrue:[index _ index-1].
+ 	^index!

Item was added:
+ ----- Method: LineIntersections>>indexForInserting: (in category 'private') -----
+ indexForInserting: aPoint
+ 	"Return the appropriate index for inserting the given x value"
+ 	| index low high side |
+ 	low _ 1.
+ 	high _ activeEdges size.
+ 	[index _ (high + low) bitShift: -1.
+ 	low > high] whileFalse:[
+ 		side _ (activeEdges at: index) sideOfPoint: aPoint.
+ 		side = 0 ifTrue:[^index].
+ 		side > 0
+ 			ifTrue:[high _ index - 1]
+ 			ifFalse:[low _ index + 1]].
+ 	^low!

Item was added:
+ ----- Method: LineIntersections>>initializeEvents (in category 'computing') -----
+ initializeEvents
+ 	"Initialize the events for all given line segments"
+ 	| mySeg pt1 pt2 |
+ 	events _ WriteStream on: (Array new: segments size * 2).
+ 	segments do:[:seg|
+ 		pt1 _ seg start asPoint.
+ 		pt2 _ seg end asPoint.
+ 		(pt1 sortsBefore: pt2) 
+ 			ifTrue:[mySeg _ LineIntersectionSegment from: pt1 to: pt2]
+ 			ifFalse:[mySeg _ LineIntersectionSegment from: pt2 to: pt1].
+ 		mySeg referentEdge: seg.
+ 		events nextPut: (LineIntersectionEvent type: #start position: mySeg start segment: mySeg).
+ 		events nextPut: (LineIntersectionEvent type: #end position: mySeg end segment: mySeg).
+ 	].
+ 	events _ Heap withAll: events contents sortBlock: [:ev1 :ev2| ev1 sortsBefore: ev2].!

Item was added:
+ ----- Method: LineIntersections>>intersectFrom:to:with:to: (in category 'private') -----
+ intersectFrom: pt1Start to: pt1End with: pt2Start to: pt2End
+ 	| det deltaPt alpha beta pt1Dir pt2Dir |
+ 	pt1Dir _ pt1End - pt1Start.
+ 	pt2Dir _ pt2End - pt2Start.
+ 	det _ (pt1Dir x * pt2Dir y) - (pt1Dir y * pt2Dir x).
+ 	deltaPt _ pt2Start - pt1Start.
+ 	alpha _ (deltaPt x * pt2Dir y) - (deltaPt y * pt2Dir x).
+ 	beta _ (deltaPt x * pt1Dir y) - (deltaPt y * pt1Dir x).
+ 	det = 0 ifTrue:[^nil]. "no intersection"
+ 	alpha * det < 0 ifTrue:[^nil].
+ 	beta * det < 0 ifTrue:[^nil].
+ 	det > 0 
+ 		ifTrue:[(alpha > det or:[beta > det]) ifTrue:[^nil]]
+ 		ifFalse:[(alpha < det or:[beta < det]) ifTrue:[^nil]].
+ 	"And compute intersection"
+ 	^pt1Start + (alpha * pt1Dir / (det at det))!

Item was added:
+ ----- Method: LineIntersections>>isLeft:comparedTo: (in category 'private') -----
+ isLeft: dir1 comparedTo: dir2
+ 	"Return true if dir1 is left of dir2"
+ 	| det |
+ 	det _ ((dir1 x * dir2 y) - (dir2 x * dir1 y)).
+ 	"det = 0 ifTrue:[self error:'line on line']."
+ 	^det <= 0!

Item was added:
+ ----- Method: LineIntersections>>processEvents (in category 'computing') -----
+ processEvents
+ 	| evt |
+ 	intersections _ WriteStream on: (Array new: segments size).
+ 	activeEdges _ OrderedCollection new.
+ 	[events isEmpty] whileFalse:[
+ 		evt _ events removeFirst.
+ 		evt type == #start ifTrue:[self startEdgeEvent: evt].
+ 		evt type == #end ifTrue:[self endEdgeEvent: evt].
+ 		evt type == #cross 
+ 			ifTrue:[self crossEdgeEvent: evt]
+ 			ifFalse:[lastIntersections _ nil].
+ 	].!

Item was added:
+ ----- Method: LineIntersections>>recordIntersection:with:at: (in category 'computing') -----
+ recordIntersection: edge with: other at: evtPoint
+ 	intersections nextPut:
+ 		(Array with: evtPoint
+ 				with: edge referentEdge
+ 				with: other referentEdge).!

Item was added:
+ ----- Method: LineIntersections>>startEdgeEvent: (in category 'computing') -----
+ startEdgeEvent: evt
+ 	| idx edge evtPoint index keepChecking other side |
+ 	edge _ evt segment.
+ 	Debug == true ifTrue:[self debugDrawLine: edge color: Color blue].
+ 	evtPoint _ evt position.
+ 	"Find left-most insertion point"
+ 	idx _ self firstIndexForInserting: evtPoint.
+ 	index _ idx.
+ 	keepChecking _ true.
+ 	"Check all edges containing the same insertion point"
+ 	[idx <= activeEdges size
+ 		ifTrue:[	other _ activeEdges at: idx.
+ 				side _ other sideOfPoint: evtPoint]
+ 		ifFalse:[side _ -1].
+ 	side = 0] whileTrue:[
+ 		idx _ idx + 1.
+ 		self recordIntersection: edge with: other at: evtPoint.
+ 		"Check edges as long as we haven't found the insertion index"
+ 		keepChecking ifTrue:[
+ 			(self isLeft: other direction comparedTo: edge direction)
+ 				ifTrue:[index _ index + 1]
+ 				ifFalse:[keepChecking _ false]].
+ 	].
+ 	activeEdges add: edge afterIndex: index-1.
+ 	self computeIntersectionAt: index-1 belowOrRightOf: evtPoint.
+ 	self computeIntersectionAt: index belowOrRightOf: evtPoint.!

Item was added:
+ PluggableListMorph subclass: #ListComponent
+ 	instanceVariableNames: 'selectedItem setSelectionSelector'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Components'!

Item was added:
+ ----- Method: ListComponent>>changeModelSelection: (in category 'model access') -----
+ changeModelSelection: anInteger
+ 	"Change the model's selected item index to be anInteger."
+ 
+ 	setIndexSelector
+ 		ifNil: 	["If model is not hooked up to index, then we won't get
+ 					an update, so have to do it locally."
+ 				self selectionIndex: anInteger]
+ 		ifNotNil: [model perform: setIndexSelector with: anInteger].
+ 	selectedItem _ anInteger = 0 ifTrue: [nil] ifFalse: [self getListItem: anInteger].
+ 	setSelectionSelector ifNotNil:
+ 		[model perform: setSelectionSelector with: selectedItem]!

Item was added:
+ ----- Method: ListComponent>>initFromPinSpecs (in category 'components') -----
+ initFromPinSpecs
+ 	| ioPin |
+ 	getListSelector := pinSpecs first modelReadSelector.
+ 	ioPin := pinSpecs second.
+ 	getIndexSelector := ioPin isInput 
+ 		ifTrue: [ioPin modelReadSelector]
+ 		ifFalse: [nil].
+ 	setIndexSelector := ioPin isOutput 
+ 				ifTrue: [ioPin modelWriteSelector]
+ 				ifFalse: [nil].
+ 	setSelectionSelector := pinSpecs third modelWriteSelector!

Item was added:
+ ----- Method: ListComponent>>initPinSpecs (in category 'components') -----
+ initPinSpecs 
+ 	pinSpecs _ Array
+ 		with: (PinSpec new pinName: 'list' direction: #input
+ 				localReadSelector: nil localWriteSelector: nil
+ 				modelReadSelector: getListSelector modelWriteSelector: nil
+ 				defaultValue: #(one two three) pinLoc: 1.5)
+ 		with: (PinSpec new pinName: 'index' direction: #inputOutput
+ 				localReadSelector: nil localWriteSelector: nil
+ 				modelReadSelector: getIndexSelector modelWriteSelector: setIndexSelector
+ 				defaultValue: 0 pinLoc: 2.5)
+ 		with: (PinSpec new pinName: 'selectedItem' direction: #output
+ 				localReadSelector: nil localWriteSelector: nil
+ 				modelReadSelector: nil modelWriteSelector: setSelectionSelector
+ 				defaultValue: nil pinLoc: 3.5)!

Item was added:
+ ----- Method: ListComponent>>list: (in category 'initialization') -----
+ list: listOfItems
+ 	super list: listOfItems.
+ 	self selectionIndex: 0.
+ 	selectedItem _ nil.
+ 	setSelectionSelector ifNotNil:
+ 		[model perform: setSelectionSelector with: selectedItem]!

Item was added:
+ Dictionary subclass: #LiteralDictionary
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Compiler-Support'!
+ 
+ !LiteralDictionary commentStamp: '<historical>' prior: 0!
+ A LiteralDictionary, like an IdentityDictionary, has a special test for equality.  In this case it is simple equality between objects of like class.  This allows equal Float or String literals to be shared without the possibility of erroneously sharing, say, 1 and 1.0!

Item was added:
+ ----- Method: LiteralDictionary>>arrayEquality:and: (in category 'as yet unclassified') -----
+ arrayEquality: x and: y
+ 
+ 	x size = y size ifFalse: [^ false].
+ 	x with: y do: [:e1 :e2 | 
+ 		(self literalEquality: e1 and: e2) ifFalse: [^ false]
+ 	].
+ 	^true.
+ !

Item was added:
+ ----- Method: LiteralDictionary>>literalEquality:and: (in category 'testing') -----
+ literalEquality: x and: y
+ 
+ 	^ (x class = Array and: [y class = Array]) ifTrue: [
+ 		self arrayEquality: x and: y.
+ 	] ifFalse: [
+ 		(x class == y class) and: [x = y]
+ 	].
+ !

Item was added:
+ ----- Method: LiteralDictionary>>scanFor: (in category 'as yet unclassified') -----
+ scanFor: anObject
+ 	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
+ 	| element start finish |
+ 	finish _ array size.
+ 	start _ (anObject hash \\ finish) + 1.
+ 	
+ 
+ 	"Search from (hash mod size) to the end."
+ 	start to: finish do:
+ 		[:index | ((element _ array at: index) == nil
+ 					or: [self literalEquality: element key and: anObject])
+ 					ifTrue: [^ index ]].
+ 
+ 	"Search from 1 to where we started."
+ 	1 to: start-1 do:
+ 		[:index | ((element _ array at: index) == nil
+ 					or: [self literalEquality: element key and: anObject])
+ 					ifTrue: [^ index ]].
+ 
+ 	^ 0  "No match AND no empty slot"!

Item was added:
+ ----- Method: LiteralNode>>defaultBlockType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultBlockType: t1 
+ 	^ #default!

Item was added:
+ ----- Method: LiteralNode>>defaultMessageType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultMessageType
+ 	^ #none!

Item was added:
+ ----- Method: LiteralNode>>emitForValue:on: (in category '*Etoys-Squeakland-code generation') -----
+ emitForValue: stack on: strm
+ 
+ 	code < 256
+ 		ifTrue: [strm nextPut: code]
+ 		ifFalse: [self emitLong: LoadLong on: strm].
+ 	stack push: 1!

Item was added:
+ ----- Method: LiteralNode>>firstInReceivers: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ firstInReceivers: t1 
+ 	^ t1 first!

Item was added:
+ ----- Method: LiteralNode>>initialNil (in category '*Etoys-Tweak-Kedama-Generated') -----
+ initialNil
+ 	^ nil!

Item was added:
+ ----- Method: LiteralNode>>isStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isStmt: t1 
+ 	^ t1 = #top
+ 		or: [t1 = #condition]!

Item was added:
+ ----- Method: LiteralNode>>isTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTest: t1 parentNode: t2 
+ 	t1 = true
+ 		ifTrue: [^ true].
+ 	^ (t2 isMemberOf: MessageNode)
+ 		and: [t2 receiver = self
+ 				and: [t2 messageType value = #condition]]!

Item was added:
+ ----- Method: LiteralNode>>isTopStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmt: t1 
+ 	t1 = nil
+ 		ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: LiteralNode>>precedence (in category '*Etoys-Squeakland-code generation') -----
+ precedence
+ 
+ 	^ 0!

Item was added:
+ ----- Method: LiteralNode>>rcvr: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr: t1 
+ 	^ t1!

Item was added:
+ ----- Method: LiteralNode>>thisNode (in category '*Etoys-Tweak-Kedama-Generated') -----
+ thisNode
+ 	^ self!

Item was added:
+ ----- Method: LiteralNode>>transfer: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 
+ 	^ t1!

Item was added:
+ ----- Method: LiteralVariableNode>>defaultBlockType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultBlockType: t1 
+ 	^ #default!

Item was added:
+ ----- Method: LiteralVariableNode>>defaultMessageType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultMessageType
+ 	^ #none!

Item was added:
+ ----- Method: LiteralVariableNode>>firstInReceivers: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ firstInReceivers: t1 
+ 	^ t1 first!

Item was added:
+ ----- Method: LiteralVariableNode>>initialNil (in category '*Etoys-Tweak-Kedama-Generated') -----
+ initialNil
+ 	^ nil!

Item was added:
+ ----- Method: LiteralVariableNode>>isStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isStmt: t1 
+ 	^ t1 = #top
+ 		or: [t1 = #condition]!

Item was added:
+ ----- Method: LiteralVariableNode>>isTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTest: t1 parentNode: t2 
+ 	t1 = true
+ 		ifTrue: [^ true].
+ 	^ (t2 isMemberOf: MessageNode)
+ 		and: [t2 receiver = self
+ 				and: [t2 messageType value = #condition]]!

Item was added:
+ ----- Method: LiteralVariableNode>>isTopStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmt: t1 
+ 	t1 = nil
+ 		ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: LiteralVariableNode>>rcvr: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr: t1 
+ 	^ t1!

Item was added:
+ ----- Method: LiteralVariableNode>>rewriteVariable:with:rewriteInfo: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rewriteVariable: t1 with: t2 rewriteInfo: t3 
+ 	t2
+ 		ifNil: [^ nil].
+ 	t2 first = t1
+ 		ifTrue: [^ t3].
+ 	^ nil!

Item was added:
+ ----- Method: LiteralVariableNode>>thisNode (in category '*Etoys-Tweak-Kedama-Generated') -----
+ thisNode
+ 	^ self!

Item was added:
+ ----- Method: LiteralVariableNode>>transfer: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 
+ 	^ t1!

Item was added:
+ ----- Method: LiteralVariableNode>>variableReceiver: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ variableReceiver: t1 
+ 	| t2 t3 |
+ 	(self key isKindOf: LookupKey)
+ 		ifTrue: [^ self key value].
+ 	t3 := self key.
+ 	t2 := Compiler new
+ 				evaluate: t3 asString
+ 				in: nil
+ 				to: t1
+ 				notifying: nil
+ 				ifFail: []
+ 				logged: false.
+ 	^ t2!

Item was added:
+ ----- Method: Locale class>>previous: (in category '*Etoys-Squeakland-accessing') -----
+ previous: aLocale
+ 	Previous := aLocale
+ !

Item was added:
+ ----- Method: LookupKey>>hashMappedBy: (in category '*Etoys-Squeakland-comparing') -----
+ hashMappedBy: map
+ 	"Answer what my hash would be if oops changed according to map."
+ 
+ 	^key hashMappedBy: map!

Item was added:
+ LanguageEnvironment subclass: #M17nEnvironment
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-Languages'!
+ 
+ !M17nEnvironment commentStamp: 'kks 10/2/2010 19:45' prior: 0!
+ This class supports multilingual Unicode environments that use UTF-8 encoding. Such a large scope implies the use of external fonts and external rendering engines like Pango. Currently, it is useful for Indic and a few Asian languages.!

Item was added:
+ ----- Method: M17nEnvironment class>>clipboardInterpreterClass (in category 'subclass responsibilities') -----
+ clipboardInterpreterClass
+ 
+ 	^ UTF8ClipboardInterpreter.
+ !

Item was added:
+ ----- Method: M17nEnvironment class>>fileNameConverterClass (in category 'subclass responsibilities') -----
+ fileNameConverterClass
+ 
+ 	^ UTF8TextConverter.
+ !

Item was added:
+ ----- Method: M17nEnvironment class>>inputInterpreterClass (in category 'subclass responsibilities') -----
+ inputInterpreterClass
+ 	| platformName |
+ 	platformName := SmalltalkImage current platformName.
+ 	platformName = 'Win32'
+ 			ifTrue: [ 'CE' = (SmalltalkImage current getSystemAttribute: 1002)
+ 						ifTrue: [^ MacRomanInputInterpreter]].
+ 	platformName = 'MacOS'
+ 			ifTrue: [^MacRomanInputInterpreter].
+ 	^M17nInputInterpreter.!

Item was added:
+ ----- Method: M17nEnvironment class>>leadingChar (in category 'subclass responsibilities') -----
+ leadingChar
+ 
+ 	^ Unicode leadingChar.
+ !

Item was added:
+ ----- Method: M17nEnvironment class>>supportedLanguages (in category 'subclass responsibilities') -----
+ supportedLanguages
+ 	"Include languages that will not conflict with other languages"
+ 	
+ 	^#('bn' 'gu' 'hi' 'kn' 'ml' 'mr' 'ta' 'te' 'sa')!

Item was added:
+ ----- Method: M17nEnvironment class>>systemConverterClass (in category 'subclass responsibilities') -----
+ systemConverterClass
+ 
+ 	^ UTF8TextConverter.!

Item was added:
+ KeyboardInputInterpreter subclass: #M17nInputInterpreter
+ 	instanceVariableNames: 'converter'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-TextConversion'!
+ 
+ !M17nInputInterpreter commentStamp: 'kks 10/2/2010 23:26' prior: 0!
+ A flexible input interpreter that is tuned to variations in keyboard events coming in from the VM.
+ 
+ Old VMs passed only a 8-bit keycode evt[3] and 0 in evt[6]. This code could be in any one of the code pages. On Mac, this used mac-roman, while on Unix, this could be ASCII or UTF-8 depending on the locale.
+ 
+ Newer VMs pass UTF32 in evt[6]. This can be 'cooked' based on the current language setting to generate a Character.!

Item was added:
+ ----- Method: M17nInputInterpreter>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 
+ 	converter _ UTF8TextConverter new.!

Item was added:
+ ----- Method: M17nInputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') -----
+ nextCharFrom: sensor firstEvt: evtBuf 
+ 	| keyValue |
+ 	keyValue := evtBuf at: 6.
+ 	0 = keyValue ifTrue: [ ^self nextUtf8Char: sensor firstEvt: evtBuf ].
+ 	256 > keyValue ifTrue: [ ^keyValue asCharacter ].
+ 	^ Character leadingChar: (Locale current languageEnvironment leadingChar) code: keyValue!

Item was added:
+ ----- Method: M17nInputInterpreter>>nextUtf8Char:firstEvt: (in category 'as yet unclassified') -----
+ nextUtf8Char: sensor firstEvt: evtBuf
+ 	"this code should really go into InputSensor>>fullKey"
+ 	| aCollection bytes peekEvent keyValue type stream multiChar evt |
+ 	self flag: #fixthis.
+ 	keyValue _ evtBuf third.
+ 	evtBuf fourth = EventKeyChar ifTrue: [type _ #keystroke].
+ 	peekEvent _ sensor peekEvent.
+ 	(peekEvent notNil and: [peekEvent fourth = EventKeyDown]) ifTrue: [
+ 		sensor nextEvent.
+ 		peekEvent _ sensor peekEvent].
+ 
+ 	(type == #keystroke
+ 	and: [peekEvent notNil 
+ 	and: [peekEvent first = EventTypeKeyboard
+ 	and: [peekEvent fourth = EventKeyChar]]]) ifTrue: [
+ 		aCollection _ OrderedCollection with: keyValue asCharacter.
+ 		bytes _ (keyValue <= 127)
+ 			ifTrue: [ 0 ]
+ 			ifFalse: [ (keyValue bitAnd: 16rE0) = 192
+ 				ifTrue: [ 1 ]
+ 				ifFalse: [ (keyValue bitAnd: 16rF0) = 224
+ 					ifTrue: [ 2 ]
+ 					ifFalse: [ 3 ]
+ 				]
+ 			].
+ 		[bytes > 0] whileTrue: [
+ 			(evt :=  sensor nextEvent) fourth = EventKeyChar ifTrue: [
+ 				bytes := bytes - 1.
+ 				aCollection add: (Character value: evt third)]].
+ 		"aCollection do: [ :each | Transcript show: (each asciiValue hex , ' ')].
+ 		Transcript show: Character cr."
+ 		stream _ ReadStream on: (String withAll: aCollection).
+ 		multiChar _ converter nextFromStream: stream.
+ 		multiChar isOctetCharacter ifFalse: [ sensor nextEvent ].
+ 		^ multiChar].
+ 
+ 	^ keyValue asCharacter!

Item was added:
+ PianoKeyboardMorph subclass: #MIDIPianoKeyboardMorph
+ 	instanceVariableNames: 'midiPort channel velocity'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sound-Interface'!
+ 
+ !MIDIPianoKeyboardMorph commentStamp: '<historical>' prior: 0!
+ I implement a piano keyboard that can be played with the mouse. I can output to a MIDI port, if MIDI is supported on this platform. I can also spawn controllers for other MIDI parameters, such as pitch bend.
+ !

Item was added:
+ ----- Method: MIDIPianoKeyboardMorph>>addCustomMenuItems:hand: (in category 'menus') -----
+ addCustomMenuItems: aCustomMenu hand: aHandMorph
+ 
+ 	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ 	midiPort
+ 		ifNil: [aCustomMenu add: 'play via MIDI' translated action: #openMIDIPort]
+ 		ifNotNil: [
+ 			aCustomMenu add: 'play via built in synth' translated action: #closeMIDIPort.
+ 			aCustomMenu add: 'new MIDI controller' translated action: #makeMIDIController:].
+ !

Item was added:
+ ----- Method: MIDIPianoKeyboardMorph>>closeMIDIPort (in category 'as yet unclassified') -----
+ closeMIDIPort
+ 
+ 	midiPort _ nil.
+ !

Item was added:
+ ----- Method: MIDIPianoKeyboardMorph>>initialize (in category 'initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ 	super initialize.
+ ""
+ 	SimpleMIDIPort midiIsSupported
+ 		ifTrue: [midiPort _ SimpleMIDIPort openDefault].
+ 	channel _ 1.
+ 	velocity _ 100!

Item was added:
+ ----- Method: MIDIPianoKeyboardMorph>>makeMIDIController: (in category 'as yet unclassified') -----
+ makeMIDIController: evt
+ 
+ 	self world activeHand attachMorph:
+ 		(MIDIControllerMorph new midiPort: midiPort).
+ !

Item was added:
+ ----- Method: MIDIPianoKeyboardMorph>>mouseDownPitch:event:noteMorph: (in category 'simple keyboard') -----
+ mouseDownPitch: midiKey event: event noteMorph: noteMorph
+ 
+ 	midiPort ifNil: [^ super mouseDownPitch: midiKey-1 event: event noteMorph: noteMorph].
+ 	noteMorph color: playingKeyColor.
+ 	soundPlaying
+ 		ifNil: [midiPort ensureOpen]
+ 		ifNotNil: [self turnOffNote].
+ 	self turnOnNote: midiKey + 23.
+ !

Item was added:
+ ----- Method: MIDIPianoKeyboardMorph>>mouseUpPitch:event:noteMorph: (in category 'simple keyboard') -----
+ mouseUpPitch: midiKey event: event noteMorph: noteMorph
+ 
+ 	midiPort ifNil: [
+ 		^ super mouseUpPitch: midiKey event: event noteMorph: noteMorph].
+ 
+ 	noteMorph color:
+ 		((#(0 1 3 5 6 8 10) includes: midiKey \\ 12)
+ 			ifTrue: [whiteKeyColor]
+ 			ifFalse: [blackKeyColor]).
+ 	soundPlaying ifNotNil: [self turnOffNote].
+ !

Item was added:
+ ----- Method: MIDIPianoKeyboardMorph>>openMIDIPort (in category 'as yet unclassified') -----
+ openMIDIPort
+ 
+ 	| portNum |
+ 	portNum _ SimpleMIDIPort outputPortNumFromUser.
+ 	portNum ifNil: [^ self].
+ 	midiPort _ SimpleMIDIPort openOnPortNumber: portNum.
+ !

Item was added:
+ ----- Method: MIDIPianoKeyboardMorph>>turnOffNote (in category 'as yet unclassified') -----
+ turnOffNote
+ 
+ 	midiPort notNil & soundPlaying notNil ifTrue: [
+ 		soundPlaying isInteger ifTrue: [
+ 			midiPort midiCmd: 16r90 channel: channel byte: soundPlaying byte: 0]].
+ 	soundPlaying _ nil.
+ !

Item was added:
+ ----- Method: MIDIPianoKeyboardMorph>>turnOnNote: (in category 'as yet unclassified') -----
+ turnOnNote: midiKey
+ 
+ 	midiPort midiCmd: 16r90 channel: channel byte: midiKey byte: velocity.
+ 	soundPlaying _ midiKey.
+ !

Item was added:
+ Object subclass: #MIMEType
+ 	instanceVariableNames: 'main sub parameters'
+ 	classVariableNames: 'DefaultSuffixes StandardMIMEMappings'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-MIME'!

Item was added:
+ ----- Method: MIMEType class>>contentTypeMultipart (in category 'instance creation') -----
+ contentTypeMultipart
+ 	^self main: 'multipart' sub: 'form-data'!

Item was added:
+ ----- Method: MIMEType class>>contentTypeURLEncoded (in category 'instance creation') -----
+ contentTypeURLEncoded
+ 	^self main: 'application' sub: 'x-www-form-urlencoded'!

Item was added:
+ ----- Method: MIMEType class>>defaultHTML (in category 'instance creation') -----
+ defaultHTML
+ 	^self main: 'text' sub: 'html'!

Item was added:
+ ----- Method: MIMEType class>>defaultStream (in category 'instance creation') -----
+ defaultStream
+ 	^self main: 'application' sub: 'octet-stream'!

Item was added:
+ ----- Method: MIMEType class>>defaultSuffixes (in category 'class initialization') -----
+ defaultSuffixes
+ 	"MIMEType defaultSuffixes"
+ 
+ 	^DefaultSuffixes ifNil: [DefaultSuffixes := self initializeDefaultSuffixes]!

Item was added:
+ ----- Method: MIMEType class>>defaultText (in category 'instance creation') -----
+ defaultText
+ 	^self main: 'text' sub: 'plain'!

Item was added:
+ ----- Method: MIMEType class>>forExtension: (in category 'instance creation') -----
+ forExtension: fileExtension
+ 	| mime |
+ 	SmalltalkImage current platformName = 'Mac OS'
+ 		ifTrue: 
+ 			[mime _ MIMETypeMacResolver getMIMETypeForFilename: 'a.',fileExtension].
+ 	mime ifNotNil: [^mime].
+ 	^(self mimeMappings at: fileExtension asLowercase ifAbsent: [^nil]) first!

Item was added:
+ ----- Method: MIMEType class>>forFileName: (in category 'instance creation') -----
+ forFileName: fileName
+ 	| ext type |
+ 	ext := FileDirectory extensionFor: fileName.
+ 	(ext = '' and: [SmalltalkImage current platformName = 'Mac OS'])
+ 		 ifTrue: [type := (FileDirectory default getMacFileTypeAndCreator: fileName) at: 1.
+ 			^self forExtension: type].
+ 	^self forExtension: (FileDirectory extensionFor: fileName)!

Item was added:
+ ----- Method: MIMEType class>>fromMIMEString: (in category 'instance creation') -----
+ fromMIMEString: mimeString
+ 	| idx main rest sub parameters |
+ 	idx _ mimeString indexOf: $/.
+ 	idx = 0
+ 		ifTrue: [self error: 'Illegal mime type string "' , mimeString , '".'].
+ 	main := mimeString copyFrom: 1 to: idx-1.
+ 	rest := mimeString copyFrom: idx+1 to: mimeString size.
+ 	idx _ mimeString indexOf: $;.
+ 	idx = 0
+ 		ifTrue: [sub := rest]
+ 		ifFalse: [
+ 			sub := rest copyFrom: 1 to: idx.
+ 			parameters := rest copyFrom: idx+1 to: rest size].
+ 	 ^self
+ 		main: main
+ 		sub: sub
+ 		parameters: parameters
+ !

Item was added:
+ ----- Method: MIMEType class>>huntForDashAndRemove: (in category 'accessing') -----
+ huntForDashAndRemove: aString
+ 	| n |
+ 	(n := aString lastIndexOf: $-) > 0 ifTrue: [^aString copyFrom: n+1 to: aString size].
+ 	^aString
+ !

Item was added:
+ ----- Method: MIMEType class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"MIMEType initialize"
+ 
+ 	self initializeStandardMIMETypes.  
+ 	FileDirectory initializeStandardMIMETypes.!

Item was added:
+ ----- Method: MIMEType class>>initializeDefaultSubTypeSuffixes (in category 'class initialization') -----
+ initializeDefaultSubTypeSuffixes
+ 	"MIMEType initializeDefaultSubTypeSuffixes"
+ 
+ 	| defaultSuffixes |
+ 	defaultSuffixes _ Dictionary new: 43.
+ 	defaultSuffixes
+ 		at: 'jpeg' put: 'jpg';
+ 		yourself.
+ 	^defaultSuffixes!

Item was added:
+ ----- Method: MIMEType class>>initializeDefaultSuffixes (in category 'class initialization') -----
+ initializeDefaultSuffixes
+ 	"MIMEType initializeDefaultSubTypeSuffixes"
+ 	"DefaultSuffixes := nil"
+ 
+ 	| defaultSuffixes |
+ 	defaultSuffixes _ Dictionary new: 43.
+ 	defaultSuffixes
+ 		at: 'image/jpeg' put: 'jpg';
+ 		at: 'audio/x-mpeg' put: 'mp3';
+ 		at: 'video/x-mpeg' put: 'mpg';
+ 		at: 'image/png' put: 'png';
+ 		at: 'text/xml' put: 'xml';
+ 		yourself.
+ 	^defaultSuffixes!

Item was added:
+ ----- Method: MIMEType class>>initializeStandardMIMETypes (in category 'class initialization') -----
+ initializeStandardMIMETypes
+ 	"MIMEType initializeStandardMIMETypes"
+ 
+ 	StandardMIMEMappings _ Dictionary new.
+ 	self standardMIMETypes keysAndValuesDo:[:extension :mimeStrings |
+ 		StandardMIMEMappings
+ 			at: extension asString asLowercase
+ 			put: (mimeStrings collect: [:mimeString | MIMEType fromMIMEString: mimeString]).
+ 	].!

Item was added:
+ ----- Method: MIMEType class>>main:sub: (in category 'instance creation') -----
+ main: mainType sub: subType
+ 	^self new
+ 		main: mainType;
+ 		sub: subType!

Item was added:
+ ----- Method: MIMEType class>>main:sub:parameters: (in category 'instance creation') -----
+ main: mainType sub: subType parameters: parameters
+ 	^self new
+ 		main: mainType;
+ 		sub: subType;
+ 		parameters: parameters!

Item was added:
+ ----- Method: MIMEType class>>mimeMappings (in category 'accessing') -----
+ mimeMappings
+ 	^StandardMIMEMappings!

Item was added:
+ ----- Method: MIMEType class>>simpleSuffixForMimeType: (in category 'accessing') -----
+ simpleSuffixForMimeType: mimeType
+ 	^(self defaultSuffixes at: mimeType ifAbsent: [self  huntForDashAndRemove: mimeType sub]) asSymbol!

Item was added:
+ ----- Method: MIMEType class>>standardMIMETypes (in category 'class initialization') -----
+ standardMIMETypes
+ 	"MIMEType standardMIMETypes"
+ 	"We had to split this method because of the 256 literal limit in methods."
+ 	| mimeTypes |
+ 	mimeTypes _ self standardMIMETypes2.
+ 	mimeTypes
+ 		at: 'adr' put: #('application/x-msaddr');
+ 		at: 'jpe' put: #('image/jpeg');
+ 		at: 'ttf' put: #('application/x-truetypefont');
+ 		at: 'wiz' put: #('application/msword');
+ 		at: 'xml' put: #('text/xml' 'text/html');
+ 		at: 'ppz' put: #('application/vnd.ms-powerpoint');
+ 		at: 'rpm' put: #('audio/x-pn-realaudio-plugin');
+ 		at: 'rgb' put: #('image/x-rgb');
+ 		at: 'mid' put: #('audio/midi' 'audio/x-midi');
+ 		at: 'pnm' put: #('image/x-portable-anymap');
+ 		at: 'bcpio' put: #('application/x-bcpio');
+ 		at: 'pot' put: #('application/vnd.ms-powerpoint');
+ 		at: 'o' put: #('application/octet-stream');
+ 		at: 'vgp' put: #('video/x-videogram-plugin');
+ 		at: 'ua' put: #('text/plain');
+ 		at: 'zpa' put: #('application/pcphoto');
+ 		at: 'pdf' put: #('application/pdf');
+ 		at: 'class' put: #('application/octet-stream');
+ 		at: 'ra' put: #('audio/x-realaudio');
+ 		at: 'ips' put: #('application/ips');
+ 		at: 'uu' put: #('application/octet-stream');
+ 		at: 'sh' put: #('application/x-sh');
+ 		at: 'ebk' put: #('application/x-expandedbook');
+ 		at: 'pbm' put: #('image/x-portable-bitmap');
+ 		at: 'ram' put: #('audio/x-pn-realaudio');
+ 		at: 'tsv' put: #('text/tab-separated-values');
+ 		at: 'dvi' put: #('application/x-dvi');
+ 		at: 'lha' put: #('application/octet-stream');
+ 		at: 'gif' put: #('image/gif');
+ 		at: 'aif' put: #('audio/x-aiff');
+ 		at: 'etx' put: #('text/x-setext');
+ 		at: 'jfif-tbnl' put: #('image/jpeg');
+ 		at: 'pps' put: #('application/vnd.ms-powerpoint');
+ 		at: 'mp3' put: #('audio/mpeg' 'audio/x-mpeg');
+ 		at: 'pgr' put: #('text/parsnegar-document');
+ 		at: 'con' put: #('application/x-connector');
+ 		at: 'viv' put: #('video/vnd.vivo');
+ 		at: 'latex' put: #('application/x-latex');
+ 		at: 'h' put: #('text/plain');
+ 		at: 'ms' put: #('application/x-troff-ms');
+ 		at: 'zip' put: #('application/zip');
+ 		at: 'axs' put: #('application/olescript');
+ 		at: 'gtar' put: #('application/x-gtar');
+ 		at: 'fhc' put: #('image/x-freehand');
+ 		at: 'asf' put: #('video/x-ms-asf');
+ 		at: 'm3u' put: #('audio/x-mpeg');
+ 		at: 'ai' put: #('application/postscript');
+ 		at: 'movie' put: #('video/x-sgi-movie' 'video/x-sgi.movie');
+ 		at: 'exe' put: #('application/octet-stream');
+ 		at: 'htm' put: #('text/html' 'text/plain');
+ 		at: 'a' put: #('application/octet-stream');
+ 		at: 'mv' put: #('video/x-sgi-movie');
+ 		at: 'fh4' put: #('image/x-freehand');
+ 		at: 'avi' put: #('video/avi');
+ 		at: 'tiff' put: #('image/tiff');
+ 		at: 'mpga' put: #('audio/mpeg');
+ 		at: 'mov' put: #('video/mov');
+ 		at: 'html' put: #('text/html' 'text/plain');
+ 		at: 'hqx' put: #('application/mac-binhex40' 'application/octet-stream');
+ 		at: 'ras' put: #('image/x-cmu-rast');
+ 		at: 'arc' put: #('application/octet-stream');
+ 		at: 'dump' put: #('application/octet-stream');
+ 		at: 'jfif' put: #('image/jpeg');
+ 		at: 'dus' put: #('audio/x-dspeech');
+ 		at: 'me' put: #('application/x-troff-me');
+ 		at: 'mime' put: #('message/rfc822');
+ 		at: 'gtaru' put: #('application/x-gtar');
+ 		at: 'cdf' put: #('application/x-netcdf');
+ 		at: 'xpm' put: #('image/x-xpixmap');
+ 		at: 'jpg' put: #('image/jpeg');
+ 		at: 'dot' put: #('application/msword');
+ 		at: 'css' put: #('text/css' 'text/x-css');
+ 		at: 'chat' put: #('application/x-chat');
+ 		at: 'gz' put: #('application/gzip');
+ 		at: 'mp2' put: #('audio/mpeg');
+ 		at: 'cpt' put: #('application/mac-compactpro');
+ 		at: 'wlt' put: #('application/x-mswallet');
+ 		at: 'text' put: #('text/plain');
+ 		at: 'wsrc' put: #('application/x-wais-source');
+ 		at: 'xwd' put: #('image/x-xwindowdump');
+ 		at: 'rm' put: #('audio/x-pn-realaudio');
+ 		at: 'wrl' put: #('model/vrml');
+ 		at: 'doc' put: #('application/ms-word-document' 'application/msword');
+ 		at: 'ustar' put: #('audio/basic');
+ 		at: 'js' put: #('application/x-javascript');
+ 		at: 'rtx' put: #('application/rtf');
+ 		at: 'aam' put: #('application/x-authorware-map');
+ 		at: 'oda' put: #('application/oda');
+ 		at: 'ppa' put: #('application/vnd.ms-powerpoint');
+ 		at: 'xbm' put: #('image/x-xbitmap');
+ 		at: 'cpio' put: #('application/x-cpio');
+ 		at: 'sv4crc' put: #('application/x-sv4crc');
+ 		at: 'mpg' put: #('video/mpg' 'video/mpeg' 'video/x-mpeg');
+ 		at: 't' put: #('application/x-troff');
+ 		at: 'txt' put: #('text/plain');
+ 		at: 'sit' put: #('application/x-stuffit');
+ 		at: 'wid' put: #('application/x-DemoShield');
+ 		at: 'swf' put: #('application/x-shockwave-flash');
+ 		at: 'lzh' put: #('application/octet-stream');
+ 		at: 'au' put: #('audio/basic');
+ 		at: 'java' put: #('text/plain');
+ 		at: 'mpeg' put: #('video/mpeg' 'video/x-mpeg');
+ 		at: 'qt' put: #('video/quicktime');
+ 		at: 'pgm' put: #('image/x-portable-graymap');
+ 		at: 'hdf' put: #('application/x-hdf');
+ 		at: 'c' put: #('text/plain');
+ 		at: 'cpp' put: #('text/plain');
+ 		at: 'vgx' put: #('video/x-videogram');
+ 		at: 'aifc' put: #('audio/x-aiff');
+ 		at: 'tex' put: #('application/x.tex');
+ 		at: 'wav' put: #('audio/wav' 'audio/x-wav');
+ 		at: 'ivr' put: #('i-world/i-vrml');
+ 		at: 'saveme' put: #('application/octet-stream');
+ 		at: 'csh' put: #('application/x-csh');
+ 		at: 'aas' put: #('application/x-authorware-map');
+ 		at: 'tar' put: #('application/x-tar');
+ 		at: 'vivo' put: #('video/vnd.vivo');
+ 		yourself.
+ 	^mimeTypes!

Item was added:
+ ----- Method: MIMEType class>>standardMIMETypes2 (in category 'class initialization') -----
+ standardMIMETypes2
+ 	"MIMEType standardMimeTypes2"
+ 	"We had to split this method because of the 256 literal limit in methods."
+ 	| mimeTypes |
+ 	mimeTypes _ Dictionary new: 100.
+ 	mimeTypes
+ 		at: 'nc' put: #('application/x-netcdf');
+ 		at: 'shar' put: #('application/x-shar');
+ 		at: 'pgp' put: #('application/x-pgp-plugin');
+ 		at: 'texi' put: #('application/x-texinfo');
+ 		at: 'z' put: #('application/x-compress');
+ 		at: 'aiff' put: #('audio/aiff' 'audio/x-aiff');
+ 		at: 'bin' put: #('application/octet-stream');
+ 		at: 'pwz' put: #('application/vnd.ms-powerpoint');
+ 		at: 'rtc' put: #('application/rtc');
+ 		at: 'asx' put: #('video/x-ms-asf');
+ 		at: 'ief' put: #('image/ief');
+ 		at: 'ps' put: #('application/postscript');
+ 		at: 'xls' put: #('application/vnd.ms-excel');
+ 		at: 'vrml' put: #('model/vrml');
+ 		at: 'jpeg' put: #('image/jpeg');
+ 		at: 'dwg' put: #('image/vnd');
+ 		at: 'dms' put: #('application/octet-stream');
+ 		at: 'tif' put: #('image/tiff');
+ 		at: 'roff' put: #('application/x-troff');
+ 		at: 'midi' put: #('audio/midi');
+ 		at: 'eps' put: #('application/postscript');
+ 		at: 'man' put: #('application/x-troff-man');
+ 		at: 'sv4cpio' put: #('application/x-sv4cpio');
+ 		at: 'tr' put: #('application/x-troff');
+ 		at: 'dxf' put: #('image/vnd');
+ 		at: 'rtf' put: #('text/rtf' 'application/rtf');
+ 		at: 'frl' put: #('application/freeloader');
+ 		at: 'xlb' put: #('application/vnd.ms-excel');
+ 		at: 'pl' put: #('text/plain');
+ 		at: 'snd' put: #('audio/basic');
+ 		at: 'texinfo' put: #('application/x-texinfo');
+ 		at: 'tbk' put: #('application/toolbook');
+ 		at: 'ppm' put: #('image/x-portable-pixmap');
+ 		at: 'cht' put: #('audio/x-dspeech');
+ 		at: 'bmp' put: #('image/bmp');
+ 		at: 'vgm' put: #('video/x-videogram');
+ 		at: 'fh5' put: #('image/x-freehand');
+ 		at: 'src' put: #('application/x-wais-source');
+ 		at: 'm4' put: #('audio/x-mp4-audio');
+ 		at: 'm4b' put: #('audio/x-quicktime-protected-b');
+ 		at: 'm4p' put: #('audio/x-quicktime-protected');
+ 		at: 'mp4v' put: #('video/x-mp4-video');
+ 		at: 'm4v' put: #('video/x-mp4-video');
+ 		at: 'mp4' put: #('video/x-mp4-video');
+ 		at: 'wma' put: #('audio/x-ms-wma');
+ 		at: 'wmv' put: #('video/x-ms-wmv');
+ 		at: 'wm' put: #('video/x-ms-wm');
+ 		at: 'png' put: #('image/png');
+ 		yourself.
+ 	^mimeTypes
+ !

Item was added:
+ ----- Method: MIMEType class>>suffixForMimeType: (in category 'accessing') -----
+ suffixForMimeType: mimeType
+ 	^self defaultSuffixes at: mimeType ifAbsent: [mimeType sub]!

Item was added:
+ ----- Method: MIMEType>>= (in category 'comparing') -----
+ = anotherObject
+ 	anotherObject class == self class
+ 		ifFalse: [^false].
+ 	^self main = anotherObject main
+ 		and: [self sub = anotherObject sub]!

Item was added:
+ ----- Method: MIMEType>>asMIMEType (in category 'converting') -----
+ asMIMEType
+ 	^self!

Item was added:
+ ----- Method: MIMEType>>beginsWith: (in category 'comparing') -----
+ beginsWith: aString
+ 	^self printString beginsWith: aString!

Item was added:
+ ----- Method: MIMEType>>hash (in category 'comparing') -----
+ hash
+ 	^self main hash bitXor: self sub hash!

Item was added:
+ ----- Method: MIMEType>>main (in category 'accessing') -----
+ main
+ 	^main!

Item was added:
+ ----- Method: MIMEType>>main: (in category 'accessing') -----
+ main: mainType
+ 	main _ mainType!

Item was added:
+ ----- Method: MIMEType>>parameters: (in category 'accessing') -----
+ parameters: params
+ 	parameters := params!

Item was added:
+ ----- Method: MIMEType>>printOn: (in category 'printing') -----
+ printOn: stream
+ 	stream
+ 		nextPutAll: main; nextPut: $/ ; nextPutAll: sub!

Item was added:
+ ----- Method: MIMEType>>sub (in category 'accessing') -----
+ sub
+ 	^sub!

Item was added:
+ ----- Method: MIMEType>>sub: (in category 'accessing') -----
+ sub: subType
+ 	sub _ subType!

Item was added:
+ WiWPasteUpMorph subclass: #MVCWiWPasteUpMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-ST80-Morphic'!
+ 
+ !MVCWiWPasteUpMorph commentStamp: '<historical>' prior: 0!
+ A subclass of WiWPasteUpMorph that supports Morphic worlds embedded in MVC Views.!

Item was added:
+ ----- Method: MVCWiWPasteUpMorph>>becomeTheActiveWorldWith: (in category 'activation') -----
+ becomeTheActiveWorldWith: evt
+ 
+ 	worldState canvas: nil.	"safer to start from scratch"
+ 	self installFlaps.
+ 
+ !

Item was added:
+ ----- Method: MVCWiWPasteUpMorph>>invalidRect:from: (in category 'change reporting') -----
+ invalidRect: damageRect from: aMorph
+ 
+ 	worldState ifNil: [^self].
+ 	worldState recordDamagedRect: damageRect
+ !

Item was added:
+ ----- Method: MVCWiWPasteUpMorph>>position: (in category 'geometry') -----
+ position: aPoint
+ 	"Change the position of this morph and and all of its submorphs."
+ 
+ 	| delta |
+ 	delta _ aPoint - bounds topLeft.
+ 	(delta x = 0 and: [delta y = 0]) ifTrue: [^ self].  "Null change"
+ 	self changed.
+ 	self privateFullMoveBy: delta.
+ 	self changed.
+ !

Item was added:
+ ----- Method: MVCWiWPasteUpMorph>>project (in category 'project') -----
+ project
+ 	^ Project current!

Item was added:
+ ----- Method: MVCWiWPasteUpMorph>>resetViewBox (in category 'geometry') -----
+ resetViewBox
+ 	| c |
+ 	(c := worldState canvas) isNil ifTrue: [^self resetViewBoxForReal].
+ 	c form == Display ifFalse: [^self resetViewBoxForReal].
+ 	c origin = (0 @ 0) ifFalse: [^self resetViewBoxForReal].
+ 	c clipRect extent = self viewBox extent 
+ 		ifFalse: [^self resetViewBoxForReal]!

Item was added:
+ ----- Method: MVCWiWPasteUpMorph>>resetViewBoxForReal (in category 'geometry') -----
+ resetViewBoxForReal
+ 
+ 	self viewBox ifNil: [^self].
+ 	worldState canvas: (
+ 		(Display getCanvas)
+ 			copyOffset:  0 at 0
+ 			clipRect: self viewBox
+ 	)!

Item was added:
+ ----- Method: MVCWiWPasteUpMorph>>revertToParentWorldWithEvent: (in category 'activation') -----
+ revertToParentWorldWithEvent: evt
+ 
+ ">>unused, but we may want some of this later
+ 	self damageRecorder reset.
+ 	World _ parentWorld.
+ 	World assuredCanvas.
+ 	World installFlaps.
+ 	owner changed.
+ 	hostWindow setStripeColorsFrom: Color red.
+ 	World restartWorldCycleWithEvent: evt.
+ <<<"
+ 
+ !

Item was added:
+ ----- Method: MVCWiWPasteUpMorph>>viewBox: (in category 'project state') -----
+ viewBox: newViewBox 
+ 	| vb |
+ 	worldState resetDamageRecorder.	"since we may have moved, old data no longer valid"
+ 	((vb := self viewBox) isNil or: [vb ~= newViewBox]) 
+ 		ifTrue: [worldState canvas: nil].
+ 	worldState viewBox: newViewBox.
+ 	self bounds: newViewBox.	"works better here than simply storing into bounds"
+ 	worldState assuredCanvas.
+ 	"Paragraph problem workaround; clear selections to avoid screen droppings:"
+ 	self flag: #arNote.	"Probably unnecessary"
+ 	worldState handsDo: [:h | h releaseKeyboardFocus].
+ 	self fullRepaintNeeded!

Item was added:
+ ----- Method: MVCWiWPasteUpMorph>>worldUnderCursor (in category 'as yet unclassified') -----
+ worldUnderCursor
+ 
+         ^self!

Item was added:
+ ClipboardInterpreter subclass: #MacUTF8ClipboardInterpreter
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-TextConversion'!

Item was added:
+ ----- Method: MacUTF8ClipboardInterpreter>>fromSystemClipboard: (in category 'as yet unclassified') -----
+ fromSystemClipboard: aString
+ 	^ aString convertFromWithConverter: UTF8TextConverter new!

Item was added:
+ ----- Method: MacUTF8ClipboardInterpreter>>toSystemClipboard: (in category 'as yet unclassified') -----
+ toSystemClipboard: text
+ 
+ 	| string |
+ 	string := text asString.
+ 	string isAsciiString ifTrue: [^ string asOctetString].
+ 	string isOctetString ifTrue: [^ string ].
+ 	^ string convertToWithConverter: UTF8TextConverter new .
+ !

Item was added:
+ ----- Method: MacUnicodeInputInterpreter>>keyValueIndex (in category '*Etoys-Squeakland-accessing') -----
+ keyValueIndex
+ 	^ keyValueIndex!

Item was added:
+ ----- Method: MacUnicodeInputInterpreter>>keycodeFor: (in category '*Etoys-Squeakland-keyboard') -----
+ keycodeFor: anInteger
+ 	"interpret the key from an up/down event, if necessary"
+ 	^ self virtualKeycodeToSqueak: anInteger!

Item was added:
+ ----- Method: MacUnicodeInputInterpreter>>majorMinorBuildFrom:satisfies: (in category '*Etoys-Squeakland-version check') -----
+ majorMinorBuildFrom: aString satisfies: aBlock 
+ 	| versionArray |
+ 	versionArray := SmalltalkImage current macVmMajorMinorBuildVersion.
+ 	^ aBlock valueWithArguments: versionArray!

Item was added:
+ ----- Method: MacUnicodeInputInterpreter>>virtualKeycodeToSqueak: (in category '*Etoys-Squeakland-conversion') -----
+ virtualKeycodeToSqueak: anInteger
+ 	^VirtualKeycodes at: anInteger + 1 ifAbsent: [0]
+ !

Item was added:
+ ----- Method: MagnifierMorph>>magnification (in category '*Etoys-Squeakland-magnifying') -----
+ magnification
+ 	"Answer the value of my magnification."
+ 
+ 	^ magnification!

Item was added:
+ ----- Method: MagnifierMorph>>trackPointer (in category '*Etoys-Squeakland-menu') -----
+ trackPointer
+ 	"Answer the value of my trackPointer."
+ 
+ 	^ trackPointer!

Item was added:
+ ----- Method: MagnifierMorph>>trackPointer: (in category '*Etoys-Squeakland-menu') -----
+ trackPointer: aBoolean
+ 	"Set the value of my trackPointer."
+ 
+ 	trackPointer := aBoolean!

Item was added:
+ ----- Method: Magnitude>>hashMappedBy: (in category '*Etoys-Squeakland-comparing') -----
+ hashMappedBy: map
+ 	"My hash is independent of my oop."
+ 
+ 	^self hash!

Item was added:
+ EventMorph subclass: #MediaEventMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !MediaEventMorph commentStamp: 'sw 12/21/2006 22:36' prior: 0!
+ An EventMorph representing a media event, such as the playing of a sound or a movie clip.!

Item was added:
+ ----- Method: MediaEventMorph>>addCustomMenuItems:hand: (in category 'menus') -----
+ addCustomMenuItems: aCustomMenu hand: aHandMorph
+ 	"Add morph-specific items to the given menu which was invoked by the given hand.  This method provides is invoked both from the halo-menu and from the control-menu regimes."
+ 
+ 	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ 	aCustomMenu addTranslatedList:
+ 		#(( 'play' play 'play the event in isolation.')) translatedNoop!

Item was added:
+ ----- Method: MediaEventMorph>>play (in category 'playing') -----
+ play
+ 	"Play my event in isolation, if possible."
+ 
+ 	event play!

Item was added:
+ MorphicUnknownEvent subclass: #MediaPlayEvent
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !MediaPlayEvent commentStamp: 'sw 12/21/2006 22:36' prior: 0!
+ An event representing the playing of a media object such as a sound or a movie.!

Item was added:
+ ----- Method: MediaPlayEvent>>duration (in category 'accessing') -----
+ duration
+ 	"Answer the duration of the event, in seconds."
+ 
+ 	^ argument ifNil: [0] ifNotNil: [argument duration]!

Item was added:
+ ----- Method: MediaPlayEvent>>durationInMilliseconds (in category 'accessing') -----
+ durationInMilliseconds
+ 	"Answer the duration of the event in milliseconds."
+ 
+ 	^ argument ifNil: [0] ifNotNil: [argument durationInMilliseconds]!

Item was added:
+ ----- Method: MediaPlayEvent>>endTime (in category 'accessing') -----
+ endTime
+ 	"Answer the end time of the receiver."
+ 
+ 	^ argument ifNil: [timeStamp] ifNotNil: [timeStamp + argument duration]!

Item was added:
+ ----- Method: MediaPlayEvent>>play (in category 'accessing') -----
+ play
+ 	"In  isolation, play the media event if possible."
+ 
+ 	argument play
+ 
+ !

Item was added:
+ EventRecorderMorph subclass: #MentoringEventRecorder
+ 	instanceVariableNames: 'recordingSpace startPlaybackTime millisecondsIntoPlayback'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !MentoringEventRecorder commentStamp: 'sw 12/23/2006 15:21' prior: 0!
+ A custom subclass of the EventRecorderMorph used within the olpc mentoring system.  The event theatre's "state" constitutes the state for the MentoringEventRecorder itself as well.  These are not the same states that are used by the vanilla EventRcorderMorph superclass.
+ 
+ The states are:
+ 
+ readyToRecord				No recording ever made
+ 
+ rewound						After a rewind.   Not recording, not playing
+ atEndOfPlayback				After a playback  Not recording, not playing
+ 
+ recordingWithSound			Currently making primary recording, with sound
+ recording						Currenty making primary recoring, sans sound
+ 
+ playback						Amid playback
+ playbackAddingVoiceover	Recording a voiceover while while playing back
+ 
+ suspendedPlayback			User hit Pause while doing playback
+ 
+ !

Item was added:
+ ----- Method: MentoringEventRecorder class>>durationInMillisecondsOfTape: (in category 'services') -----
+ durationInMillisecondsOfTape: anArray
+ 	"Answer the total duration in milliseconds of the event tape represnted by the array."
+ 
+ 	| baseline totalDuration |
+ 	totalDuration := 0.
+ 	baseline := anArray first timeStamp.
+ 	anArray do:
+ 		[:anEvent |
+ 			anEvent type = #noCondense  ifFalse:  "exclude the noCondense weirdos because their timestamps can be bogus"
+ 				[totalDuration := anEvent timeStamp + anEvent durationInMilliseconds - baseline]].
+ 	^ totalDuration
+ 	!

Item was added:
+ ----- Method: MentoringEventRecorder>>addButtons (in category 'initialization') -----
+ addButtons
+ 	"Add buttons to the receiver.  For the mentoring case, the buttons are actually  managed by the EventRecordingSpace."
+ 
+ 	self makeStatusLight!

Item was added:
+ ----- Method: MentoringEventRecorder>>addJournalFile (in category 'initialization') -----
+ addJournalFile
+ 	"In case there is a chance of not regaining control to stop recording and save a file, the EventRecorder can write directly to file as it is recording.  This is useful for capturing a sequence that results in a nasty crash."
+ 
+ 	journalFile ifNotNil: [journalFile close].
+ 	journalFile _ FileStream newFileNamed: (FileDirectory default nextNameFor: 'EventRecorder' extension: 'tape').
+ 	journalFile nextPutAll:'Event Tape v1 ASCII'; cr.!

Item was added:
+ ----- Method: MentoringEventRecorder>>addVoiceControls (in category 'sound') -----
+ addVoiceControls 
+ 	"Add voice capabililty by allocating a sound recorder."
+ 
+ 	voiceRecorder _ SoundRecorder new
+ 		desiredSampleRate: 11025.0;		"<==try real hard to get the low rate"
+ 		codec: (GSMCodec new).		"<--this should compress better than ADPCM.. is it too slow?"
+ 		"codec: (ADPCMCodec new initializeForBitsPerSample: 4 samplesPerFrame: 0)."
+ 
+ 	recordMeter _ Morph new extent: 1 at 16; color: Color yellow.
+ !

Item was added:
+ ----- Method: MentoringEventRecorder>>assuredVoiceRecorder (in category 'sound') -----
+ assuredVoiceRecorder
+ 	"Answer my voiceRecorder, allocating a new one if necessary."
+ 
+ 	^ voiceRecorder ifNil: 
+ 		[self addVoiceControls.
+ 		voiceRecorder]!

Item was added:
+ ----- Method: MentoringEventRecorder>>caption (in category 'accessing') -----
+ caption
+ 	"Answer the caption, a string... initialize it to a default value if it is not yet defined."
+ 
+ 	^ caption ifNil: [caption := 'Untitled' translated]!

Item was added:
+ ----- Method: MentoringEventRecorder>>caption: (in category 'commands') -----
+ caption: aCaption
+ 	"Set the receiver's caption."
+ 
+ 	caption := aCaption!

Item was added:
+ ----- Method: MentoringEventRecorder>>currentEventTimeStamp: (in category 'event handling') -----
+ currentEventTimeStamp: aStamp
+ 	"Make a note of the current event time stamp, for the benefit of piano rolls tracking my playback."
+ 
+ 	millisecondsIntoPlayback := aStamp - startPlaybackTime!

Item was added:
+ ----- Method: MentoringEventRecorder>>deleteVoiceControls (in category 'menu') -----
+ deleteVoiceControls
+ 	"Stop using voice controls"
+ 
+ 	voiceRecorder := nil!

Item was added:
+ ----- Method: MentoringEventRecorder>>doNotCondense: (in category 'events-processing') -----
+ doNotCondense: action
+ 	"When a user gesture should not have its points condensed, such as painting a stroke, this is called with the symbol action.  Also called with #mouseUp: when a stroke is finished.
+ 	New kind of event:  CondenseAllowEvent, CondenseForbidEvent.  Insert one at start of stroke, and one at end."
+ 
+ 	| strokeEvent |
+ 	(#(#paint: #erase: #stamp:) includes: action) ifTrue: [
+ 		noCondense == true ifFalse: [noCondense _ true.
+ 			strokeEvent _ MorphicUnknownEvent new setType: #noCondense argument: action.
+ 			strokeEvent timeStamp: Time millisecondClockValue.
+ 			tapeStream nextPut: strokeEvent.
+ 			journalFile ifNotNil: [journalFile store: strokeEvent; cr; flush]].
+ 		^ self].
+ 	action == #mouseUp: ifTrue: [noCondense _ false.
+ 			strokeEvent _ MorphicUnknownEvent new setType: #noCondense argument: action.
+ 			strokeEvent timeStamp: Time millisecondClockValue.
+ 			tapeStream nextPut: strokeEvent.
+ 			journalFile ifNotNil: [journalFile store: strokeEvent; cr; flush].
+ 			^ self].
+ 	"A way to report which events not caught"
+ 	"noCondense == true ifFalse: [Transcript show: 'Assume this paint action is just a click: ',action; cr]."
+ !

Item was added:
+ ----- Method: MentoringEventRecorder>>fileNameForTape (in category 'fileIn/Out') -----
+ fileNameForTape
+ 	"Answer a file name to use for the event tape"
+ 
+ 	^ FileDirectory default nextNameFor: 'EventRecorder' extension: 'tape'!

Item was added:
+ ----- Method: MentoringEventRecorder>>findPlayOffset (in category 'commands') -----
+ findPlayOffset
+ 	"Compute the difference between my content area and the one in which the events I will play back were recorded."
+ 
+ 	areaOffset := recordingSpace areaOffset!

Item was added:
+ ----- Method: MentoringEventRecorder>>handleEscape (in category 'commands') -----
+ handleEscape
+ 	"The user hit esc to stop recording or playback, so stop."
+ 
+ 	| interimTape unmatchedMouseDown upEvent |
+ 	tapeStream ifNotNil:
+ 		[(#(recording recordingWithSound) includes: self state ) ifTrue:
+ 			[interimTape := tapeStream contents.
+ 			unmatchedMouseDown := nil.
+ 			interimTape reversed detect:
+ 				[:evt |
+ 					evt eventType = #mouseDown
+ 						ifTrue:
+ 							[unmatchedMouseDown := evt.
+ 							true]
+ 						ifFalse:
+ 							[evt eventType = #mouseUp]]
+ 				ifNone:
+ 					[nil].
+ 			unmatchedMouseDown ifNotNil:
+ 				["synthesize a matching up-event"
+ 				upEvent := unmatchedMouseDown veryDeepCopy.
+ 				upEvent timeStamp: Time millisecondClockValue.
+ 				upEvent setType: #mouseUp.
+ 				tapeStream nextPut: upEvent].
+ 
+ 			tape _ tapeStream contents.
+ 			saved _ false]].
+ 
+ 	self pauseIn: self world.
+ 	tapeStream _ nil.
+ 	recordMeter ifNotNil: [recordMeter width: 1].
+ 
+ 	recordingSpace escapeHitInEventRecorder!

Item was added:
+ ----- Method: MentoringEventRecorder>>handleListenEvent: (in category 'events-processing') -----
+ handleListenEvent: anEvent
+ 	"Process a listen event."
+ 
+ 	anEvent hand == recHand ifFalse: [^ self].	"not for me"
+ 	(#(recording recordingWithSound) includes: self state)  ifFalse: 
+ 		["If user got an error while recording and deleted recorder, will still be listening"
+ 		recHand ifNotNil: [recHand removeEventListener: self].
+ 		^ self].
+ 	anEvent = lastEvent ifTrue: [^ self].
+ 	(anEvent isKeyboard and: [anEvent keyValue = 27 "esc"])
+ 		ifTrue: [^ self handleEscape].
+ 	time _ anEvent timeStamp.
+ 	tapeStream ifNotNil:
+ 		[tapeStream nextPut: (anEvent copy setHand: nil)].
+ 	lastEvent _ anEvent!

Item was added:
+ ----- Method: MentoringEventRecorder>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver."
+ 
+ 	super initialize.
+ 	startPlaybackTime := 0.
+ 	millisecondsIntoPlayback := 0.
+ 	self assuredVoiceRecorder!

Item was added:
+ ----- Method: MentoringEventRecorder>>mergeMediaEvent: (in category 'event handling') -----
+ mergeMediaEvent: anEvent
+ 	"Merge the event, presently time-stamped with a relative time-stamp., with my existing tape.  Answer the merged tape.  It is the responsibility of the sender to notify other objects that may be interested in the change, such as an event roll."
+ 
+ 	| itsTimeStamp eventFollowingIt newTape anIndex itsCopy copysTimeStamp |
+ 	itsTimeStamp :=  anEvent timeStamp.
+ 	itsCopy := anEvent copy.
+ 	itsCopy timeStamp: (copysTimeStamp := itsTimeStamp + tape first timeStamp).
+ 
+ 	eventFollowingIt := tape detect: [:evt | evt timeStamp > copysTimeStamp]  ifNone: [nil].
+ 	anIndex := eventFollowingIt
+ 		ifNil:
+ 			[tape size + 1]
+ 		ifNotNil:
+ 			[tape indexOf: eventFollowingIt].
+ 
+ 	newTape := Array streamContents:
+ 		[:aStream | 
+ 			tape doWithIndex:
+ 				[:evt :index |
+ 					index = anIndex ifTrue:
+ 						[aStream nextPut: itsCopy].
+ 					aStream nextPut: evt].
+ 			anIndex > tape size ifTrue: [aStream nextPut: itsCopy]].
+ 
+ 	tape := newTape!

Item was added:
+ ----- Method: MentoringEventRecorder>>millisecondsIntoPlayback (in category 'accessing') -----
+ millisecondsIntoPlayback
+ 	"Answer the value of millisecondsIntoPlayback"
+ 
+ 	^ self state = #atEndOfPlayback
+ 		ifTrue:
+ 			[self myDurationInMS + (tape last duration)]
+ 		ifFalse:
+ 			[millisecondsIntoPlayback]!

Item was added:
+ ----- Method: MentoringEventRecorder>>millisecondsIntoPlayback: (in category 'accessing') -----
+ millisecondsIntoPlayback: anObject
+ 	"Set the value of millisecondsIntoPlayback"
+ 
+ 	millisecondsIntoPlayback _ anObject!

Item was added:
+ ----- Method: MentoringEventRecorder>>nextEventToPlay (in category 'event handling') -----
+ nextEventToPlay
+ 	"Return the next event when it is time to be replayed.
+ 	If it is not yet time, then return an interpolated mouseMove.
+ 	Return nil if nothing has happened.
+ 	Return an EOF event if there are no more events to be played."
+ 
+ 	| nextEvent now nextTime lastP delta |
+ 	(tapeStream isNil or:[tapeStream atEnd]) 
+ 		ifTrue:[^MorphicUnknownEvent new setType: #EOF argument: nil].
+ 	now _ Time millisecondClockValue.
+ 	nextEvent _ tapeStream next clone.	"always copied"
+ 	areaOffset ifNotNil: [nextEvent isMouse ifTrue: 
+ 		[nextEvent position: nextEvent position + areaOffset]]. 
+ 	nextEvent isKeyboard ifTrue: [ nextEvent setPosition: areaBounds center].
+ 	nextEvent type == #noCondense ifTrue: [^nil].	"ignore in playback"
+ 	deltaTime ifNil:[deltaTime _ now - nextEvent timeStamp].
+ 	nextTime _ nextEvent timeStamp + deltaTime.
+ 	now < time ifTrue:["clock rollover"
+ 		time _ now.
+ 		deltaTime _ nil.
+ 		^nil "continue it on next cycle"].
+ 	time _ now.
+ 	(now >= nextTime) ifTrue:[
+ 		nextEvent setTimeStamp: nextTime.
+ 		nextEvent isMouse ifTrue:[lastEvent _ nextEvent] ifFalse:[lastEvent _ nil].
+ 		^nextEvent].
+ 	tapeStream skip: -1.
+ 	"Not time for the next event yet, but interpolate the mouse.
+ 	This allows tapes to be compressed when velocity is fairly constant."
+ 	lastEvent ifNil: [^ nil].
+ 	now - lastInterpolation < 20 "WorldState minCycleLapse" ifTrue: [^ nil].
+ 	lastP _ lastEvent position.
+ 	delta _ (nextEvent position - lastP) * (now - lastEvent timeStamp) // (nextTime - lastEvent timeStamp).
+ 	(delta dist: lastDelta) < 3 ifTrue: [^ nil]. "Almost no movement"
+ 	lastDelta _ delta.
+ 	lastInterpolation _ now.
+ 	^ MouseMoveEvent new
+ 		setType: #mouseMove 
+ 		startPoint: lastEvent position endPoint: lastP + delta
+ 		trail: nil buttons: lastEvent buttons hand: nil stamp: now.!

Item was added:
+ ----- Method: MentoringEventRecorder>>noteAreaBounds (in category 'commands') -----
+ noteAreaBounds
+ 	"Note the bounds of the content area"
+ 
+ 	areaBounds _ recordingSpace contentArea bounds
+ 	!

Item was added:
+ ----- Method: MentoringEventRecorder>>noteRewound (in category 'commands') -----
+ noteRewound
+ 	"Note that the user has done a 'rewind'"
+ 
+ 	self state: nil.
+ 	millisecondsIntoPlayback := 0!

Item was added:
+ ----- Method: MentoringEventRecorder>>objectTrackingEvents (in category 'event handling') -----
+ objectTrackingEvents
+ 	"Answer an object tracking events or pseudo-event.  This is a hook allowing the EventRecordingSpace to keep track of cursor position to provide to event rolls."
+ 
+ 	^ self!

Item was added:
+ ----- Method: MentoringEventRecorder>>pauseIn: (in category 'pause/resume') -----
+ pauseIn: aWorld
+ 	"Suspend -- a stop command, typically because an EOF event was found on the event tape being played."
+ 
+ 	(#(recordingWithSound playbackAddingVoiceover) includes: self state) ifTrue:
+ 		[self terminateVoiceRecording.
+ 		self state: #atEndOfPlayback.
+ 		recHand ifNotNil: [recHand removeEventListener: self].
+ 		recHand _ nil.].
+ 
+ 	(#(playback) includes: self state) ifTrue:
+ 		[self state: #suspendedPlay.
+ 		playHand ifNotNil:
+ 			[playHand halo ifNotNil: [playHand halo delete].
+ 			playHand delete].
+ 		aWorld removeHand: playHand.
+ 		self removeProperty: #suspendedContentArea.
+ 		playHand _ nil.
+ 		recordingSpace playingEnded]
+ 	!

Item was added:
+ ----- Method: MentoringEventRecorder>>pausePlayback (in category 'commands') -----
+ pausePlayback
+ 	"The user requested pause in mid-playback.  Preserve the salient information required for a proper resume when and if the user subsquently presses 'resume'"
+ 
+ 	self state: #suspendedPlayback.
+ 	recordMeter ifNotNil: [recordMeter width: 1].
+ 	playHand suspended: true
+ !

Item was added:
+ ----- Method: MentoringEventRecorder>>perhapsPlaySound: (in category 'event handling') -----
+ perhapsPlaySound: aSound
+ 	"Perhaps play given sound.  But, if busy creating a voiceover, do not.  And if the sound is nil, being a dummy placeholder, likewise don't atempt to play it."
+ 
+ 	aSound ifNotNil: 
+ 		[(self state = #playbackAddingVoiceover) ifFalse:
+ 			[aSound play]]!

Item was added:
+ ----- Method: MentoringEventRecorder>>play (in category 'commands') -----
+ play
+ 	"Play the movie, as it were."
+ 
+ 	tape ifNil: [^ self].
+ 	tapeStream _ ReadStream on: tape.
+ 	self resumePlayIn: ActiveWorld
+ !

Item was added:
+ ----- Method: MentoringEventRecorder>>readTape (in category 'fileIn/Out') -----
+ readTape
+ 	"Put up a prompt for reading an event tape; if one is provided, read it."
+ 
+ 	| aFileStream |
+ 	aFileStream _ (FileList2 modalFileSelectorForSuffixes: #('tape' )) .
+ 	aFileStream ifNotNil: [self readTapeFrom: aFileStream]!

Item was added:
+ ----- Method: MentoringEventRecorder>>readTape: (in category 'fileIn/Out') -----
+ readTape: fileName 
+ 	"Read an event tape from the given file-name.  Answer nil if no such file."
+ 
+ 	| file |
+ 	(fileName = '') ifTrue: [^ nil]. 
+  "Note that for some reason, (FileStream isAFileNamed: '') always returns true."
+ 
+ 	self writeCheck.
+ 	(FileStream isAFileNamed: fileName) ifFalse: [^ nil].
+ 	file _ FileStream oldFileNamed: fileName.
+ 	tape _ self readFrom: file.
+ 	file close.
+ 	saved _ true  "Still exists on file"!

Item was added:
+ ----- Method: MentoringEventRecorder>>readTapeFrom: (in category 'fileIn/Out') -----
+ readTapeFrom: aFileStream
+ 	"Read in the tape from the fileStream provided."
+ 
+ 	tape _ self readFrom: aFileStream.
+ 	aFileStream close.
+ 	saved _ true  "Still exists on file"!

Item was added:
+ ----- Method: MentoringEventRecorder>>record (in category 'commands') -----
+ record
+ 	"Commence recording or re-recording."
+ 
+ 	tapeStream _ WriteStream on: (Array new: 10000).
+ 	self resumeRecordIn: ActiveWorld
+ !

Item was added:
+ ----- Method: MentoringEventRecorder>>recordMeter (in category 'sound') -----
+ recordMeter
+ 	"Hand back the actual recordMeter object."
+ 
+ 	^ recordMeter!

Item was added:
+ ----- Method: MentoringEventRecorder>>recordingSpace: (in category 'accessing') -----
+ recordingSpace: anObject
+ 	"Set the value of recordingSpace"
+ 
+ 	recordingSpace _ anObject!

Item was added:
+ ----- Method: MentoringEventRecorder>>rememberPaintBoxSettingsAtRecordingOutset (in category 'commands') -----
+ rememberPaintBoxSettingsAtRecordingOutset
+ 	"Recording is about to take place.  Remember settings if appropriate."
+ 
+ 	recordingSpace rememberPaintBoxSettingsAtRecordingOutset!

Item was added:
+ ----- Method: MentoringEventRecorder>>resumePlayIn: (in category 'pause/resume') -----
+ resumePlayIn: aWorld
+ 	"Playback" 
+ 
+ 	| anEvent aPosition |
+ 	recordingSpace abandonReplayHandsAndHalos.
+ 	self flag: #deferred.  "I guess it's the above line that messes up the nesting of these guys..."
+ 
+ 	self state: #playback.
+ 	recordingSpace populateControlsPanel.
+ 	aWorld doOneCycle.
+ 
+ 	playHand _ HandMorphForReplay new recorder: self.
+ 	[((anEvent := tapeStream next) notNil and: [(anEvent isKindOf: UserInputEvent) not])]
+ 		whileTrue: [].
+ 	aPosition := anEvent
+ 		ifNil:
+ 			[recordingSpace contentArea center]
+ 		ifNotNil:
+ 			[anEvent position].
+ 	tapeStream reset.
+ 	playHand position: aPosition + recordingSpace areaOffset.
+ 	aWorld addHand: playHand.
+ 	playHand newKeyboardFocus: aWorld.
+ 	playHand userInitials: 'play' andPicture: nil.
+ 
+ 	lastEvent _ nil.
+ 	lastDelta _ 0 at 0.
+ 	self findPlayOffset.
+ 	startPlaybackTime := Time millisecondClockValue.
+ 	millisecondsIntoPlayback := 0.
+ 
+ 	self synchronize
+ !

Item was added:
+ ----- Method: MentoringEventRecorder>>resumePlayingWithoutPassingStop (in category 'commands') -----
+ resumePlayingWithoutPassingStop
+ 	"Like play, but avoids the stop step that does more than we'd like."
+ 
+ 	tapeStream _ ReadStream on: tape.
+ 	self resumePlayIn: ActiveWorld
+ !

Item was added:
+ ----- Method: MentoringEventRecorder>>resumeRecordIn: (in category 'pause/resume') -----
+ resumeRecordIn: aWorld
+ 	"Start recording, actually."
+ 
+ 	| anEvent |
+ 	recHand _ aWorld activeHand ifNil: [aWorld primaryHand].
+ 	recHand newKeyboardFocus: aWorld.
+ 	recHand addEventListener: self.
+ 
+ 	lastEvent _ nil.
+ 	self state:  #recording.
+ 
+ 	anEvent := MorphicUnknownEvent new setType: #noteTheatreBounds argument: recordingSpace  initialContentArea bounds copy hand: nil stamp: Time millisecondClockValue.
+ 	tapeStream nextPut: anEvent.
+ 
+ 	self synchronize.
+ !

Item was added:
+ ----- Method: MentoringEventRecorder>>rewind (in category 'commands') -----
+ rewind
+ 	"Carry out a rewind."
+ 
+ 	recordingSpace abandonReplayHandsAndHalos.
+ 	recordingSpace restoreInitialContentArea!

Item was added:
+ ----- Method: MentoringEventRecorder>>saved (in category 'accessing') -----
+ saved
+ 	"Answer whether the current recording has been saved."
+ 
+ 	^ saved!

Item was added:
+ ----- Method: MentoringEventRecorder>>saved: (in category 'accessing') -----
+ saved: aBoolean
+ 	"Set the #saved inst var as indicated, with no side effects."
+ 
+ 	saved := aBoolean!

Item was added:
+ ----- Method: MentoringEventRecorder>>shrink (in category 'commands') -----
+ shrink
+ 	"Shorten the tape by deleting mouseMove events that can just as well be
+ 	interpolated later at playback time."
+ 
+ 	tape ifNil: [^ Beeper beep].
+ 	^ super shrink!

Item was added:
+ ----- Method: MentoringEventRecorder>>startRecordingNewSound (in category 'pause/resume') -----
+ startRecordingNewSound
+ 	"Commence the recording of a new sound by way of voiceover."
+ 
+ 	startSoundEvent _ MediaPlayEvent new setType: #startSound argument: nil hand: nil stamp: (Time millisecondClockValue - startPlaybackTime).
+ 	self state = #recordingWithSound
+ 		ifTrue:
+ 			[tapeStream nextPut: startSoundEvent].
+ 	"If not, then we're recording after-the-fact voiceover; in this case, we hold on to the new event and later on when the sound is complete we merge the event into the tape stream at the appropriate place."
+ 
+ 	voiceRecorder clearRecordedSound.
+ 	voiceRecorder resumeRecording!

Item was added:
+ ----- Method: MentoringEventRecorder>>startSoundEvent: (in category 'accessing') -----
+ startSoundEvent: anEvent 
+ 	"Set the receiver's startSoundEvent"
+ 
+ 	startSoundEvent := anEvent!

Item was added:
+ ----- Method: MentoringEventRecorder>>state (in category 'commands') -----
+ state
+ 	"Answer the receiver's state."
+ 
+ 	^ recordingSpace ifNotNil: [recordingSpace state]!

Item was added:
+ ----- Method: MentoringEventRecorder>>state: (in category 'accessing') -----
+ state: aState 
+ 	"Set the receiver's state."
+ 
+ 	recordingSpace
+ 		ifNotNil:
+ 			 [recordingSpace state: aState]!

Item was added:
+ ----- Method: MentoringEventRecorder>>step (in category 'stepping and presenter') -----
+ step
+ 	"Step the event recorder."
+ 	
+ 	(#(recordingWithSound playbackAddingVoiceover) includes: self state)
+ 		ifTrue:
+ 			[recordMeter width: (voiceRecorder meterLevel + 1)]!

Item was added:
+ ----- Method: MentoringEventRecorder>>stop (in category 'commands') -----
+ stop
+ 	"Stop recording or playing."
+ 
+ 	tapeStream ifNotNil:
+ 		[(#(recording recordingWithSound) includes: self state) ifTrue:
+ 			[tape _ tapeStream contents.
+ 			saved _ false]].
+ 	self terminateVoiceRecording.  "In case doing"
+ 	journalFile ifNotNil:
+ 		[journalFile close].
+ 	self pauseIn: ActiveWorld.
+ 	tapeStream _ nil.
+ 	self state: #atEndOfPlayback.
+ 	recordingSpace abandonReplayHandsAndHalos.
+ 	recordMeter ifNotNil: [recordMeter width: 1].
+ !

Item was added:
+ ----- Method: MentoringEventRecorder>>stopRecording (in category 'commands') -----
+ stopRecording
+ 	"The user hit the 'stop recording' button."
+ 
+ 	self stop!

Item was added:
+ ----- Method: MentoringEventRecorder>>tape (in category 'accessing') -----
+ tape
+ 	"Answer the current tape"
+ 
+ 	^ tape!

Item was added:
+ ----- Method: MentoringEventRecorder>>terminateVoiceRecording (in category 'pause/resume') -----
+ terminateVoiceRecording
+ 	"If I am doing voice recording,either alongside event recording or alongside event playback, stop doing it."
+ 
+ 	| snippetsList |
+ 	(#(recordingWithSound playbackAddingVoiceover) includes: self state)
+ 		ifTrue:
+ 			[voiceRecorder pause.
+ 			startSoundEvent argument: voiceRecorder recordedSound.
+ 			voiceRecorder clearRecordedSound.
+ 			self state = #playbackAddingVoiceover ifTrue:
+ 				[snippetsList := self valueOfProperty: #snippetsList ifAbsentPut: OrderedCollection new.
+ 				snippetsList add: startSoundEvent.
+ 				startSoundEvent := nil]]!

Item was added:
+ ----- Method: MentoringEventRecorder>>userStopReplayMaybe: (in category 'pause/resume') -----
+ userStopReplayMaybe: anEvent
+ 	"If the user clicks or types a keystroke within the interior during replay, return true so we can stop the replay."
+ 
+ 	(#(playback playbackAddingVoiceover) includes: self state)  ifFalse: [^ false].
+ 	(anEvent hand isKindOf: HandMorphForReplay) ifTrue: [^ false].	"ignore own events"
+ 	(anEvent isKeyboard or: [anEvent isMouse and: [anEvent anyButtonPressed]]) 
+ 			ifFalse: [^ false]. "mouse move"
+ 	"got a click or keystroke"
+ 	(anEvent isMouse and: [recordingSpace controlsPanel bounds containsPoint: anEvent position])
+ 		ifTrue: [^ false]. 
+ 	^ true!

Item was added:
+ ----- Method: MentoringEventRecorder>>voiceRecorder (in category 'accessing') -----
+ voiceRecorder
+ 	"Answer the receiver's voiceRecorder."
+ 
+ 	^ voiceRecorder!

Item was added:
+ ----- Method: MentoringEventRecorder>>voiceRecorder: (in category 'initialization') -----
+ voiceRecorder: v
+ 	"Set the voiceRecorder"
+ 
+ 	voiceRecorder := v!

Item was added:
+ ----- Method: MentoringEventRecorder>>writeCheck (in category 'fileIn/Out') -----
+ writeCheck
+ 	"Well, for now we just don't..."
+ 
+ "
+ 	(saved not and: [self confirm: 'The current tape has not been saved.
+ Would you like to do so now?']) ifTrue:
+ 		[self writeTape]."
+ !

Item was added:
+ ----- Method: MentoringEventRecorder>>writeTape (in category 'fileIn/Out') -----
+ writeTape
+ 	"Write the tape."
+ 
+ 	| args bb aFileName |
+ 	bb _ self findDeepSubmorphThat: [:mm | (mm isKindOf: SimpleButtonMorph)
+ 				and: [mm label = 'writeTape']] 
+ 			ifAbsent: [nil].
+ 	args := bb ifNil: [#()] ifNotNil: [bb arguments].
+ 	(args notEmpty and: [args first notEmpty]) 
+ 		ifTrue: 
+ 			[args first.
+ 			self writeTape: args first]
+ 		ifFalse: 
+ 			[aFileName := self fileNameForTape.
+ 			self writeTape: aFileName].!

Item was added:
+ ----- Method: MenuItemMorph>>drawExtraIconOn:forStringBounds: (in category '*Etoys-Squeakland-drawing') -----
+ drawExtraIconOn: aCanvas forStringBounds: stringBounds
+ 
+ 	| ratio drawnIcon map |
+ 	self extraIcon ifNil: [^ self].
+ 	drawnIcon _ extraIcon deepCopy.
+ 	(isSelected & isEnabled) ifTrue: [
+ 		map _ (Color cachedColormapFrom: extraIcon depth to: extraIcon depth) copy.
+ 		map at: (Color transparent indexInMap: map) put: (Color black pixelWordForDepth: extraIcon depth).
+ 		map at: (Color black indexInMap: map) put: (Color white pixelWordForDepth: extraIcon depth).
+ 		(BitBlt current toForm: drawnIcon)
+ 			sourceForm: extraIcon;
+ 			sourceOrigin: 0 at 0;
+ 			combinationRule: Form over;
+ 			destX: 0 destY: 0 width: extraIcon width height: extraIcon height;
+ 			colorMap: map;
+ 			copyBits.
+ 	].
+ 	ratio _ stringBounds height / drawnIcon height asFloat.
+ 	drawnIcon _ drawnIcon magnifyBy: ratio.
+ 	aCanvas paintImage: drawnIcon at: stringBounds topRight.
+ !

Item was added:
+ ----- Method: MenuItemMorph>>extraIcon (in category '*Etoys-Squeakland-private') -----
+ extraIcon
+ 
+ 	^ extraIcon.
+ !

Item was added:
+ ----- Method: MenuItemMorph>>extraIcon: (in category '*Etoys-Squeakland-private') -----
+ extraIcon: aForm
+ 
+ 	extraIcon _ aForm.
+ !

Item was added:
+ ----- Method: MenuMorph>>addUpdating:target:selector:argumentList:extraIcon: (in category '*Etoys-Squeakland-construction') -----
+ addUpdating: wordingSelector target: target selector: aSymbol argumentList: argList extraIcon: extIcon
+ 	"Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument.  In this variant, the wording of the menu item is obtained by sending the wordingSelector to the target,  Answer the item added."
+ 
+ 	| item |
+ 	item _ UpdatingMenuItemMorph new
+ 		target: target;
+ 		selector: aSymbol;
+ 		wordingProvider: target wordingSelector: wordingSelector;
+ 		arguments: argList asArray.
+ 	self addMorphBack: item.
+ 	item extraIcon: extIcon.
+ 	^ item
+ !

Item was added:
+ ----- Method: MessageAsTempNode>>addNodeInfoTo:receiverObject:stmtChain:scriptReceiver:messageType:isStatement:isInTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ addNodeInfoTo: t1 receiverObject: t2 stmtChain: t3 scriptReceiver: t4 messageType: t5 isStatement: t6 isInTest: t7 parentNode: t8 
+ 	| t9 t10 t11 t12 t13 t14 t15 t16 t17 |
+ 	t12 := WriteStream
+ 				on: (Array new: 2).
+ 	t13 := #none.
+ 	t16 := Player readOrWriteOrNil: self selector key.
+ 	t14 := t3
+ 				inject: false
+ 				into: [:t18 :t19 | t18
+ 						| (t19 at: 2)].
+ 	(t14
+ 			and: [t7 not])
+ 		ifTrue: [t13 := #testBody].
+ 	t7
+ 		ifTrue: [t13 := #testCond].
+ 	t7
+ 		ifTrue: [t15 := t3 reverse
+ 						detect: [:t18 | t18 second]
+ 						ifNone: [self halt].
+ 			(t1 at: t15 first)
+ 				add: (Array
+ 						with: t2
+ 						with: self selector
+ 						with: self receiver
+ 						with: #read
+ 						with: t13).
+ 			^ t1].
+ 	self receiver isLeaf
+ 		ifTrue: [t2 isPlayerLike
+ 				ifTrue: [(#(#getPatchValueIn: #setPatchValueIn:to: ) includes: self selector key)
+ 						ifTrue: [t17 := self selector key = #getPatchValueIn:.
+ 							t9 := self arguments first.
+ 							t9 isLeaf
+ 								ifTrue: [t10 := (t9 key isKindOf: LookupKey)
+ 												ifTrue: [t9 key key]
+ 												ifFalse: [t9 key].
+ 									t11 := Compiler
+ 												evaluate: t10
+ 												for: t4
+ 												notifying: nil
+ 												logged: false.
+ 									t12
+ 										nextPut: (Array
+ 												with: t11
+ 												with: self selector key
+ 												with: self receiver key
+ 												with: (t17
+ 														ifTrue: [#read]
+ 														ifFalse: [#write])
+ 												with: t13).
+ 									t12
+ 										nextPut: (Array
+ 												with: t2
+ 												with: self selector key
+ 												with: self receiver key
+ 												with: (t17
+ 														ifTrue: [#write]
+ 														ifFalse: [#read])
+ 												with: t13)]
+ 								ifFalse: [t12
+ 										nextPut: (Array
+ 												with: t2
+ 												with: self selector key
+ 												with: self receiver key
+ 												with: #read
+ 												with: t13)]]
+ 						ifFalse: [t12
+ 								nextPut: (Array
+ 										with: t2
+ 										with: self selector key
+ 										with: self receiver key
+ 										with: t16
+ 										with: t13)]]]
+ 		ifFalse: [(t6
+ 					and: [t5 ~~ #condition])
+ 				ifTrue: [t12
+ 						nextPut: (Array
+ 								with: nil
+ 								with: self selector key
+ 								with: self receiver
+ 								with: t16
+ 								with: t13)]].
+ 	t12 contents
+ 		do: [:t18 | t3
+ 				do: [:t19 | (t1
+ 						at: (t19 at: 1))
+ 						addFirst: t18]].
+ 	^ t1!

Item was added:
+ ----- Method: MessageAsTempNode>>addToStmtChain:isStatement: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ addToStmtChain: t1 isStatement: t2 
+ 	| t3 |
+ 	t3 := self messageType value = #condition.
+ 	t2
+ 		ifTrue: [^ t1
+ 				copyWith: (Array with: self with: t3)].
+ 	^ t1!

Item was added:
+ ----- Method: MessageAsTempNode>>defaultBlockType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultBlockType: t1 
+ 	^ #default!

Item was added:
+ ----- Method: MessageAsTempNode>>defaultMessageType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultMessageType
+ 	^ #none!

Item was added:
+ ----- Method: MessageAsTempNode>>determineStatementType:fromDict:primaryBreedPair:messageType:isStatement:receiverObject: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ determineStatementType: t1 fromDict: t2 primaryBreedPair: t3 messageType: t4 isStatement: t5 receiverObject: t6 
+ 	| t7 t8 t9 t10 t11 t13 |
+ 	t5
+ 		ifFalse: [^ t1].
+ 	t9 := t2 at: self.
+ 	(t9
+ 			select: [:t14 | t14 first notNil
+ 					and: [t14 first isPrototypeTurtlePlayer]]) size = 0
+ 		ifTrue: [^ #none].
+ 	t4 = #sequential
+ 		ifTrue: [^ #sequential].
+ 	t1 = #sequential
+ 		ifTrue: [^ #sequential].
+ 	t3
+ 		ifNil: [^ #none].
+ 	t7 := t3 first.
+ 	t4 = #condition
+ 		ifTrue: [t11 := IdentitySet new.
+ 			t13 := IdentitySet new.
+ 			t9
+ 				do: [:t14 | 
+ 					(((t14 at: 5)
+ 									= #testBody
+ 								or: [(t14 at: 5)
+ 										= #testCond])
+ 							and: [(t14 at: 4)
+ 									~= #read])
+ 						ifTrue: [t14 first
+ 								ifNotNil: [t13 add: t14 first]].
+ 					(((t14 at: 5)
+ 									= #testBody
+ 								or: [(t14 at: 5)
+ 										= #testCond])
+ 							and: [(t14 at: 4)
+ 									= #read])
+ 						ifTrue: [t14 first
+ 								ifNotNil: [t11 add: t14 first]]].
+ 			((t13 intersection: t11)
+ 				copyWithout: t7)
+ 				ifNotEmpty: [^ #sequential].
+ 			^ #parallel].
+ 	t11 := IdentitySet new.
+ 	t13 := IdentitySet new.
+ 	t8 := OrderedCollection new.
+ 	t10 := OrderedCollection new.
+ 	t9
+ 		do: [:t14 | 
+ 			t14 first = t7
+ 				ifTrue: [((t7 isBreedSelector: t14 second)
+ 							or: [t7 isUserDefinedSelector: t14 second])
+ 						ifFalse: [t8 add: t14 second]].
+ 			t14 first
+ 				ifNil: [t10 add: t14 second]
+ 				ifNotNil: [(t14 at: 4)
+ 							== #read
+ 						ifTrue: [t11 add: t14 first].
+ 					(t14 at: 4)
+ 							== #read
+ 						ifFalse: [t13 add: t14 first]].
+ 			(t7 containsSequentialSelector: t14 second)
+ 				ifTrue: [^ #sequential]].
+ 	(t8 includes: #die)
+ 		ifTrue: [^ #die].
+ 	(((self isKindOf: AssignmentNode)
+ 				and: [t6 = t7])
+ 			and: [t7 isBreedSelector: self property property])
+ 		ifTrue: [^ #none].
+ 	(t7 areOkaySelectors: t10)
+ 		ifFalse: [^ #sequential].
+ 	(t7 vectorizableTheseSelectors: t8)
+ 		ifFalse: [^ #sequential].
+ 	((t11 intersection: t13)
+ 		copyWithout: t7)
+ 		ifNotEmpty: [^ #sequential].
+ 	^ #parallel!

Item was added:
+ ----- Method: MessageAsTempNode>>firstInReceivers: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ firstInReceivers: t1 
+ 	^ t1 first!

Item was added:
+ ----- Method: MessageAsTempNode>>isStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isStmt: t1 
+ 	^ t1 = #top
+ 		or: [t1 = #condition]!

Item was added:
+ ----- Method: MessageAsTempNode>>isTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTest: t1 parentNode: t2 
+ 	t1 = true
+ 		ifTrue: [^ true].
+ 	^ (t2 isMemberOf: MessageNode)
+ 		and: [t2 receiver = self
+ 				and: [t2 messageType value = #condition]]!

Item was added:
+ ----- Method: MessageAsTempNode>>isTopStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmt: t1 
+ 	t1 = nil
+ 		ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: MessageAsTempNode>>msgType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ msgType
+ 	(#(#ifTrue: #ifFalse: #ifTrue:ifFalse: #ifFalse:ifTrue: ) includes: self selector key)
+ 		ifTrue: [^ #condition].
+ 	(#(#whileTrue: #whileFalse: ) includes: self selector key)
+ 		ifTrue: [^ #loop].
+ 	(#(#doSequentially: ) includes: self selector key)
+ 		ifTrue: [^ #sequential].
+ 	^ #none!

Item was added:
+ ----- Method: MessageAsTempNode>>parentRewriteInfo:primaryBreedPair:isStatement:isTopStatement: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ parentRewriteInfo: t1 primaryBreedPair: t2 isStatement: t3 isTopStatement: t4 
+ 	t4
+ 		ifTrue: [t2
+ 				ifNil: [^ t1].
+ 			^ t2].
+ 	t3
+ 		ifTrue: [t2
+ 				ifNil: [^ t1].
+ 			t1
+ 				ifNil: [^ t1].
+ 			t1 first = t2 first
+ 				ifFalse: [^ t2]].
+ 	^ t1!

Item was added:
+ ----- Method: MessageAsTempNode>>primaryBreedPair:fromDict:isStatement: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ primaryBreedPair: t1 fromDict: t2 isStatement: t3 
+ 	| t4 t5 |
+ 	t3
+ 		ifTrue: [t4 := (t2 at: self)
+ 						select: [:t6 | t6 first notNil
+ 								and: [t6 first isPrototypeTurtlePlayer
+ 										and: [(t6 first isBreedSelector: t6 second) not]]].
+ 			(t4
+ 					collect: [:t6 | t6 first]) asSet size = 0
+ 				ifTrue: [^ t1].
+ 			t5 := t4 first third.
+ 			^ Array
+ 				with: t4 first first
+ 				with: ((t5 isKindOf: LookupKey)
+ 						ifTrue: [t5 key]
+ 						ifFalse: [t5])].
+ 	^ t1!

Item was added:
+ ----- Method: MessageAsTempNode>>rcvr: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr: t1 
+ 	^ t1!

Item was added:
+ ----- Method: MessageAsTempNode>>rewriteInfo:statementType:primaryBreedPair:isStatement: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rewriteInfo: t1 statementType: t2 primaryBreedPair: t3 isStatement: t4 
+ 	t4
+ 		ifTrue: [(#(#parallel #sequential #die ) includes: t2)
+ 				ifFalse: [^ nil].
+ 			t3
+ 				ifNil: [^ nil].
+ 			^ Array with: t3 first with: 'var' , t3 first identityHash printString , self identityHash printString].
+ 	^ t1!

Item was added:
+ ----- Method: MessageAsTempNode>>thisNode (in category '*Etoys-Tweak-Kedama-Generated') -----
+ thisNode
+ 	^ self!

Item was added:
+ ----- Method: MessageAsTempNode>>transfer: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 
+ 	^ t1!

Item was added:
+ ----- Method: MessageAsTempNode>>transfer:isStatement: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 isStatement: t2 
+ 	t2
+ 		ifTrue: [t1 at: self put: OrderedCollection new].
+ 	^ t1!

Item was added:
+ ----- Method: MessageNames>>inMorphicWindowWithInitialSearchString: (in category '*Etoys-Squeakland-initialization') -----
+ inMorphicWindowWithInitialSearchString: initialString
+ 	"Answer a morphic window with the given initial search string, nil if none"
+ 
+ "MessageNames openMessageNames"
+ 
+ 	| window selectorListView firstDivider secondDivider horizDivider typeInPane searchButton plugTextMor |
+ 	window _ (SystemWindow labelled: 'Message Names') model: self.
+ 	firstDivider _ 0.1.
+ 	secondDivider _ 0.5.
+ 	horizDivider _ 0.5.
+ 	typeInPane _ AlignmentMorph newRow vResizing: #spaceFill; height: 14.
+ 	typeInPane hResizing: #spaceFill.
+ 	typeInPane listDirection: #leftToRight.
+ 
+ 	plugTextMor _ PluggableTextMorph on: self
+ 					text: #searchString accept: #searchString:notifying:
+ 					readSelection: nil menu: #codePaneMenu:shifted:.
+ 	plugTextMor setProperty: #alwaysAccept toValue: true.
+ 	plugTextMor askBeforeDiscardingEdits: false.
+ 	plugTextMor acceptOnCR: true.
+ 	plugTextMor setTextColor: Color brown.
+ 	plugTextMor setNameTo: 'Search'.
+ 	plugTextMor vResizing: #spaceFill; hResizing: #spaceFill.
+ 	plugTextMor hideScrollBarsIndefinitely.
+ 	plugTextMor setTextMorphToSelectAllOnMouseEnter.
+ 
+ 	searchButton _ SimpleButtonMorph new 
+ 		target: self;
+ 		beTransparent;
+ 		label: 'Search';
+ 		actionSelector: #doSearchFrom:;
+ 		arguments: {plugTextMor}.
+ 	searchButton setBalloonText: 'Type some letters into the pane at right, and then press this Search button (or hit RETURN) and all method selectors that match what you typed will appear in the list pane below.  Click on any one of them, and all the implementors of that selector will be shown in the right-hand pane, and you can view and edit their code without leaving this tool.'.
+ 
+ 	typeInPane addMorphFront: searchButton.
+ 	typeInPane addTransparentSpacerOfSize: 6 at 0.
+ 	typeInPane addMorphBack: plugTextMor.
+ 	initialString isEmptyOrNil ifFalse:
+ 		[plugTextMor setText: initialString].
+ 
+ 	window addMorph: typeInPane frame: (0 at 0 corner: horizDivider @ firstDivider).
+ 
+ 	selectorListView _ PluggableListMorph on: self
+ 		list: #selectorList
+ 		selected: #selectorListIndex
+ 		changeSelected: #selectorListIndex:
+ 		menu: #selectorListMenu:
+ 		keystroke: #selectorListKey:from:.
+ 	selectorListView menuTitleSelector: #selectorListMenuTitle.
+ 	window addMorph: selectorListView frame: (0 @ firstDivider corner: horizDivider @ secondDivider).
+ 
+ 	window addMorph: self buildMorphicMessageList frame: (horizDivider @ 0 corner: 1@ secondDivider).
+ 
+ 	self 
+ 		addLowerPanesTo: window 
+ 		at: (0 @ secondDivider corner: 1 at 1) 
+ 		with: nil.
+ 
+ 	initialString isEmptyOrNil ifFalse:
+ 		[self searchString: initialString notifying: nil].
+ 	^ window!

Item was added:
+ ----- Method: MessageNode>>addNodeInfoTo:receiverObject:stmtChain:scriptReceiver:messageType:isStatement:isInTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ addNodeInfoTo: t1 receiverObject: t2 stmtChain: t3 scriptReceiver: t4 messageType: t5 isStatement: t6 isInTest: t7 parentNode: t8 
+ 	| t9 t10 t11 t12 t13 t14 t15 t16 t17 |
+ 	t12 := WriteStream
+ 				on: (Array new: 2).
+ 	t13 := #none.
+ 	t16 := Player readOrWriteOrNil: self selector key.
+ 	t14 := t3
+ 				inject: false
+ 				into: [:t18 :t19 | t18
+ 						| (t19 at: 2)].
+ 	(t14
+ 			and: [t7 not])
+ 		ifTrue: [t13 := #testBody].
+ 	t7
+ 		ifTrue: [t13 := #testCond].
+ 	t7
+ 		ifTrue: [t15 := t3 reverse
+ 						detect: [:t18 | t18 second]
+ 						ifNone: [self halt].
+ 			(t1 at: t15 first)
+ 				add: (Array
+ 						with: t2
+ 						with: self selector
+ 						with: self receiver
+ 						with: #read
+ 						with: t13).
+ 			^ t1].
+ 	self receiver isLeaf
+ 		ifTrue: [t2 isPlayerLike
+ 				ifTrue: [(#(#getPatchValueIn: #setPatchValueIn:to: ) includes: self selector key)
+ 						ifTrue: [t17 := self selector key = #getPatchValueIn:.
+ 							t9 := self arguments first.
+ 							t9 isLeaf
+ 								ifTrue: [t10 := (t9 key isKindOf: LookupKey)
+ 												ifTrue: [t9 key key]
+ 												ifFalse: [t9 key].
+ 									t11 := Compiler
+ 												evaluate: t10
+ 												for: t4
+ 												notifying: nil
+ 												logged: false.
+ 									t12
+ 										nextPut: (Array
+ 												with: t11
+ 												with: self selector key
+ 												with: self receiver key
+ 												with: (t17
+ 														ifTrue: [#read]
+ 														ifFalse: [#write])
+ 												with: t13).
+ 									t12
+ 										nextPut: (Array
+ 												with: t2
+ 												with: self selector key
+ 												with: self receiver key
+ 												with: (t17
+ 														ifTrue: [#write]
+ 														ifFalse: [#read])
+ 												with: t13)]
+ 								ifFalse: [t12
+ 										nextPut: (Array
+ 												with: t2
+ 												with: self selector key
+ 												with: self receiver key
+ 												with: #read
+ 												with: t13)]]
+ 						ifFalse: [t12
+ 								nextPut: (Array
+ 										with: t2
+ 										with: self selector key
+ 										with: self receiver key
+ 										with: t16
+ 										with: t13)]]]
+ 		ifFalse: [(t6
+ 					and: [t5 ~~ #condition])
+ 				ifTrue: [t12
+ 						nextPut: (Array
+ 								with: nil
+ 								with: self selector key
+ 								with: self receiver
+ 								with: t16
+ 								with: t13)]].
+ 	t12 contents
+ 		do: [:t18 | t3
+ 				do: [:t19 | (t1
+ 						at: (t19 at: 1))
+ 						addFirst: t18]].
+ 	^ t1!

Item was added:
+ ----- Method: MessageNode>>addToStmtChain:isStatement: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ addToStmtChain: t1 isStatement: t2 
+ 	| t3 |
+ 	t3 := self messageType value = #condition.
+ 	t2
+ 		ifTrue: [^ t1
+ 				copyWith: (Array with: self with: t3)].
+ 	^ t1!

Item was added:
+ ----- Method: MessageNode>>checkBlock:as:from: (in category '*Etoys-Squeakland-private') -----
+ checkBlock: node as: nodeName from: encoder
+ 
+ 	^self checkBlock: node as: nodeName from: encoder maxArgs: 0!

Item was added:
+ ----- Method: MessageNode>>defaultBlockType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultBlockType: t1 
+ 	^ #default!

Item was added:
+ ----- Method: MessageNode>>defaultMessageType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultMessageType
+ 	^ #none!

Item was added:
+ ----- Method: MessageNode>>determineStatementType:fromDict:primaryBreedPair:messageType:isStatement:receiverObject: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ determineStatementType: t1 fromDict: t2 primaryBreedPair: t3 messageType: t4 isStatement: t5 receiverObject: t6 
+ 	| t7 t8 t9 t10 t11 t13 |
+ 	t5
+ 		ifFalse: [^ t1].
+ 	t9 := t2 at: self.
+ 	(t9
+ 			select: [:t14 | t14 first notNil
+ 					and: [t14 first isPrototypeTurtlePlayer]]) size = 0
+ 		ifTrue: [^ #none].
+ 	t4 = #sequential
+ 		ifTrue: [^ #sequential].
+ 	t1 = #sequential
+ 		ifTrue: [^ #sequential].
+ 	t3
+ 		ifNil: [^ #none].
+ 	t7 := t3 first.
+ 	t4 = #condition
+ 		ifTrue: [t11 := IdentitySet new.
+ 			t13 := IdentitySet new.
+ 			t9
+ 				do: [:t14 | 
+ 					(((t14 at: 5)
+ 									= #testBody
+ 								or: [(t14 at: 5)
+ 										= #testCond])
+ 							and: [(t14 at: 4)
+ 									~= #read])
+ 						ifTrue: [t14 first
+ 								ifNotNil: [t13 add: t14 first]].
+ 					(((t14 at: 5)
+ 									= #testBody
+ 								or: [(t14 at: 5)
+ 										= #testCond])
+ 							and: [(t14 at: 4)
+ 									= #read])
+ 						ifTrue: [t14 first
+ 								ifNotNil: [t11 add: t14 first]]].
+ 			((t13 intersection: t11)
+ 				copyWithout: t7)
+ 				ifNotEmpty: [^ #sequential].
+ 			^ #parallel].
+ 	t11 := IdentitySet new.
+ 	t13 := IdentitySet new.
+ 	t8 := OrderedCollection new.
+ 	t10 := OrderedCollection new.
+ 	t9
+ 		do: [:t14 | 
+ 			t14 first = t7
+ 				ifTrue: [((t7 isBreedSelector: t14 second)
+ 							or: [t7 isUserDefinedSelector: t14 second])
+ 						ifFalse: [t8 add: t14 second]].
+ 			t14 first
+ 				ifNil: [t10 add: t14 second]
+ 				ifNotNil: [(t14 at: 4)
+ 							== #read
+ 						ifTrue: [t11 add: t14 first].
+ 					(t14 at: 4)
+ 							== #read
+ 						ifFalse: [t13 add: t14 first]].
+ 			(t7 containsSequentialSelector: t14 second)
+ 				ifTrue: [^ #sequential]].
+ 	(t8 includes: #die)
+ 		ifTrue: [^ #die].
+ 	(((self isKindOf: AssignmentNode)
+ 				and: [t6 = t7])
+ 			and: [t7 isBreedSelector: self property property])
+ 		ifTrue: [^ #none].
+ 	(t7 areOkaySelectors: t10)
+ 		ifFalse: [^ #sequential].
+ 	(t7 vectorizableTheseSelectors: t8)
+ 		ifFalse: [^ #sequential].
+ 	((t11 intersection: t13)
+ 		copyWithout: t7)
+ 		ifNotEmpty: [^ #sequential].
+ 	^ #parallel!

Item was added:
+ ----- Method: MessageNode>>eToysExpFlattenOn: (in category '*Etoys-Squeakland-accessing') -----
+ eToysExpFlattenOn: aStream
+ 
+ 	self isEToyBinaryExp ifTrue: [
+ 		self receiver eToysExpFlattenOn: aStream.
+ 		self selector eToysExpFlattenOn: aStream.
+ 		self arguments first eToysExpFlattenOn: aStream.
+ 	] ifFalse: [
+ 		aStream nextPut: self.
+ 	].
+ !

Item was added:
+ ----- Method: MessageNode>>emitIfNil:on:value: (in category '*Etoys-Squeakland-code generation') -----
+ emitIfNil: stack on: strm value: forValue
+ 
+ 	| theNode theSize |
+ 	theNode := arguments first.
+ 	theSize := sizes at: 1.
+ 	receiver emitForValue: stack on: strm.
+ 	forValue ifTrue: [strm nextPut: Dup. stack push: 1].
+ 	strm nextPut: LdNil. stack push: 1.
+ 	equalNode emit: stack args: 1 on: strm.
+ 	self 
+ 		emitBranchOn: selector key == #ifNotNil:
+ 		dist: theSize 
+ 		pop: stack 
+ 		on: strm.
+ 	pc := strm position.
+ 	forValue 
+ 		ifTrue: 
+ 			[strm nextPut: Pop.
+ 			 stack pop: 1.
+ 			 theNode emitForEvaluatedValue: stack on: strm]	
+ 		ifFalse:
+ 			[theNode emitForEvaluatedEffect: stack on: strm].!

Item was added:
+ ----- Method: MessageNode>>firstInReceivers: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ firstInReceivers: t1 
+ 	^ t1 first!

Item was added:
+ ----- Method: MessageNode>>getAllChildren (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getAllChildren
+ 
+ 	^ (Array with: receiver with: selector), arguments.
+ !

Item was added:
+ ----- Method: MessageNode>>getElderSiblingOf: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getElderSiblingOf: node
+ 
+ 	| index |
+ 	((index _ arguments indexOf: node) > 1) ifTrue: [^ arguments at: index - 1].
+ 	index = 1 ifTrue: [^ selector].
+ 	node = selector ifTrue: [^ receiver].
+ 	^ nil.
+ !

Item was added:
+ ----- Method: MessageNode>>getFirstChild (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getFirstChild
+ 
+ 	^ receiver.
+ !

Item was added:
+ ----- Method: MessageNode>>getLastChild (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getLastChild
+ 
+ 	arguments size > 0 ifTrue: [^ arguments last].
+ 	^ selector.
+ !

Item was added:
+ ----- Method: MessageNode>>isEToyBinaryExp (in category '*Etoys-Squeakland-etoys-transform') -----
+ isEToyBinaryExp
+ 
+ 	| sel |
+ 	sel _ (sel _ self selector) isSymbol ifTrue: [sel] ifFalse: [sel key].
+ 	^ (#(#+ #- #* #/ #\\ #// #max: #min:) includes: sel).
+ !

Item was added:
+ ----- Method: MessageNode>>isFirstChild: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isFirstChild: childNode
+ 
+ 	^ childNode = receiver.
+ !

Item was added:
+ ----- Method: MessageNode>>isLastChild: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isLastChild: childNode
+ 
+ 	arguments size > 0 ifTrue: [^ childNode = arguments last].
+ 	^ childNode = selector.
+ !

Item was added:
+ ----- Method: MessageNode>>isStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isStmt: t1 
+ 	^ t1 = #top
+ 		or: [t1 = #condition]!

Item was added:
+ ----- Method: MessageNode>>isTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTest: t1 parentNode: t2 
+ 	t1 = true
+ 		ifTrue: [^ true].
+ 	^ (t2 isMemberOf: MessageNode)
+ 		and: [t2 receiver = self
+ 				and: [t2 messageType value = #condition]]!

Item was added:
+ ----- Method: MessageNode>>isTopStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmt: t1 
+ 	t1 = nil
+ 		ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: MessageNode>>msgType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ msgType
+ 	(#(#ifTrue: #ifFalse: #ifTrue:ifFalse: #ifFalse:ifTrue: ) includes: self selector key)
+ 		ifTrue: [^ #condition].
+ 	(#(#whileTrue: #whileFalse: ) includes: self selector key)
+ 		ifTrue: [^ #loop].
+ 	(#(#doSequentially: ) includes: self selector key)
+ 		ifTrue: [^ #sequential].
+ 	^ #none!

Item was added:
+ ----- Method: MessageNode>>parentRewriteInfo:primaryBreedPair:isStatement:isTopStatement: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ parentRewriteInfo: t1 primaryBreedPair: t2 isStatement: t3 isTopStatement: t4 
+ 	t4
+ 		ifTrue: [t2
+ 				ifNil: [^ t1].
+ 			^ t2].
+ 	t3
+ 		ifTrue: [t2
+ 				ifNil: [^ t1].
+ 			t1
+ 				ifNil: [^ t1].
+ 			t1 first = t2 first
+ 				ifFalse: [^ t2]].
+ 	^ t1!

Item was added:
+ ----- Method: MessageNode>>primaryBreedPair:fromDict:isStatement: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ primaryBreedPair: t1 fromDict: t2 isStatement: t3 
+ 	| t4 t5 |
+ 	t3
+ 		ifTrue: [t4 := (t2 at: self)
+ 						select: [:t6 | t6 first notNil
+ 								and: [t6 first isPrototypeTurtlePlayer
+ 										and: [(t6 first isBreedSelector: t6 second) not]]].
+ 			(t4
+ 					collect: [:t6 | t6 first]) asSet size = 0
+ 				ifTrue: [^ t1].
+ 			t5 := t4 first third.
+ 			^ Array
+ 				with: t4 first first
+ 				with: ((t5 isKindOf: LookupKey)
+ 						ifTrue: [t5 key]
+ 						ifFalse: [t5])].
+ 	^ t1!

Item was added:
+ ----- Method: MessageNode>>rcvr: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr: t1 
+ 	^ t1!

Item was added:
+ ----- Method: MessageNode>>replaceNode:with: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ replaceNode: childNode with: newNode
+ 
+ 	| index |
+ 	childNode = receiver ifTrue: [receiver _ newNode. ^ self].
+ 	childNode = selector ifTrue: [selector _ newNode. ^ self].
+ 	(index _ arguments indexOf: childNode) > 0
+ 		ifTrue: [arguments at: index put: newNode. ^ self].
+ !

Item was added:
+ ----- Method: MessageNode>>rewriteInfo:statementType:primaryBreedPair:isStatement: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rewriteInfo: t1 statementType: t2 primaryBreedPair: t3 isStatement: t4 
+ 	t4
+ 		ifTrue: [(#(#parallel #sequential #die ) includes: t2)
+ 				ifFalse: [^ nil].
+ 			t3
+ 				ifNil: [^ nil].
+ 			^ Array with: t3 first with: 'var' , t3 first identityHash printString , self identityHash printString].
+ 	^ t1!

Item was added:
+ ----- Method: MessageNode>>sizeForEffect: (in category '*Etoys-Squeakland-code generation') -----
+ sizeForEffect: encoder
+ 
+ 	special > 0 
+ 		ifTrue: [^self perform: (MacroSizers at: special) with: encoder with: false].
+ 	^super sizeForEffect: encoder!

Item was added:
+ ----- Method: MessageNode>>sizeForValue: (in category '*Etoys-Squeakland-code generation') -----
+ sizeForValue: encoder
+ 	| total argSize |
+ 	special > 0 
+ 		ifTrue: [^self perform: (MacroSizers at: special) with: encoder with: true].
+ 	receiver == NodeSuper
+ 		ifTrue: [selector _ selector copy "only necess for splOops"].
+ 	total _ selector size: encoder args: arguments size super: receiver == NodeSuper.
+ 	receiver == nil 
+ 		ifFalse: [total _ total + (receiver sizeForValue: encoder)].
+ 	sizes _ arguments collect: 
+ 					[:arg | 
+ 					argSize _ arg sizeForValue: encoder.
+ 					total _ total + argSize.
+ 					argSize].
+ 	^total!

Item was added:
+ ----- Method: MessageNode>>sizeIf:value: (in category '*Etoys-Squeakland-code generation') -----
+ sizeIf: encoder value: forValue
+ 	| thenExpr elseExpr branchSize thenSize elseSize |
+ 	thenExpr _ arguments at: 1.
+ 	elseExpr _ arguments at: 2.
+ 	(forValue
+ 		or: [(thenExpr isJust: NodeNil)
+ 		or: [elseExpr isJust: NodeNil]]) not
+ 			"(...not ifTrue: avoids using ifFalse: alone during this compile)"
+ 		ifTrue:  "Two-armed IFs forEffect share a single pop"
+ 			[^ super sizeForEffect: encoder].
+ 	forValue
+ 		ifTrue:  "Code all forValue as two-armed"
+ 			[elseSize _ elseExpr sizeForEvaluatedValue: encoder.
+ 			thenSize _ (thenExpr sizeForEvaluatedValue: encoder)
+ 					+ (thenExpr returns
+ 						ifTrue: [0]  "Elide jump over else after a return"
+ 						ifFalse: [self sizeJump: elseSize]).
+ 			branchSize _ self sizeBranchOn: false dist: thenSize]
+ 		ifFalse:  "One arm is empty here (two-arms code forValue)"
+ 			[(elseExpr isJust: NodeNil)
+ 				ifTrue:
+ 					[elseSize _ 0.
+ 					thenSize _ thenExpr sizeForEvaluatedEffect: encoder.
+ 					branchSize _ self sizeBranchOn: false dist: thenSize]
+ 				ifFalse:
+ 					[thenSize _ 0.
+ 					elseSize _ elseExpr sizeForEvaluatedEffect: encoder.
+ 					branchSize _ self sizeBranchOn: true dist: elseSize]].
+ 	sizes _ Array with: thenSize with: elseSize.
+ 	^ (receiver sizeForValue: encoder) + branchSize
+ 			+ thenSize + elseSize!

Item was added:
+ ----- Method: MessageNode>>sizeToDo:value: (in category '*Etoys-Squeakland-code generation') -----
+ sizeToDo: encoder value: forValue 
+ 	" var _ rcvr. L1: [var <= arg1] Bfp(L2) [block body. var _ var + inc] Jmp(L1) L2: "
+ 	| loopSize initStmt test block incStmt blockSize blockVar initSize limitInit |
+ 	block _ arguments at: 3.
+ 	blockVar _ block firstArgument.
+ 	initStmt _ arguments at: 4.
+ 	test _ arguments at: 5.
+ 	incStmt _ arguments at: 6.
+ 	limitInit _ arguments at: 7.
+ 	initSize _ initStmt sizeForEffect: encoder.
+ 	limitInit == nil
+ 		ifFalse: [initSize _ initSize + (limitInit sizeForEffect: encoder)].
+ 	blockSize _ (block sizeForEvaluatedEffect: encoder)
+ 			+ (incStmt sizeForEffect: encoder) + 2.  "+2 for Jmp backward"
+ 	loopSize _ (test sizeForValue: encoder)
+ 			+ (self sizeBranchOn: false dist: blockSize)
+ 			+ blockSize.
+ 	sizes _ Array with: blockSize with: loopSize.
+ 	^ initSize + loopSize
+ 			+ (forValue ifTrue: [1] ifFalse: [0])    " +1 for value (push nil) "!

Item was added:
+ ----- Method: MessageNode>>sizeWhile:value: (in category '*Etoys-Squeakland-code generation') -----
+ sizeWhile: encoder value: forValue 
+ 	"L1: ... Bfp(L2) ... Jmp(L1) L2: nil (nil for value only);
+ 	justStmt, wholeLoop, justJump."
+ 	| cond stmt stmtSize loopSize branchSize |
+ 	cond _ receiver.
+ 	stmt _ arguments at: 1.
+ 	stmtSize _ (stmt sizeForEvaluatedEffect: encoder) + 2.
+ 	branchSize _ self sizeBranchOn: (selector key == #whileFalse:)  "Btp for whileFalse"
+ 					dist: stmtSize.
+ 	loopSize _ (cond sizeForEvaluatedValue: encoder)
+ 			+ branchSize + stmtSize.
+ 	sizes _ Array with: stmtSize with: loopSize.
+ 	^ loopSize    " +1 for value (push nil) "
+ 		+ (forValue ifTrue: [1] ifFalse: [0])!

Item was added:
+ ----- Method: MessageNode>>thisNode (in category '*Etoys-Tweak-Kedama-Generated') -----
+ thisNode
+ 	^ self!

Item was added:
+ ----- Method: MessageNode>>transfer: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 
+ 	^ t1!

Item was added:
+ ----- Method: MessageNode>>transfer:isStatement: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 isStatement: t2 
+ 	t2
+ 		ifTrue: [t1 at: self put: OrderedCollection new].
+ 	^ t1!

Item was added:
+ ----- Method: MessageNode>>visitBy: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ visitBy: visitor
+ 
+ 	visitor visit: self.
+ 	receiver visitBy: visitor.
+ 	selector visitBy: visitor.
+ 	arguments do: [:a | a visitBy: visitor].
+ !

Item was added:
+ ----- Method: MessageSend>>fixTemps (in category '*Etoys-Squeakland-evaluating') -----
+ fixTemps 
+ 	"compatible interface with BlockContext"!

Item was added:
+ ----- Method: Metaclass>>theNonMetaClassName (in category '*Etoys-Squeakland-accessing') -----
+ theNonMetaClassName
+ 
+ 	^thisClass name
+ !

Item was added:
+ ----- Method: MethodHolder>>contents:notifying:forInstance: (in category '*Etoys-Squeakland-contents') -----
+ contents: input notifying: aController forInstance: aPlayer
+ 	| selector |
+ 	(selector _ Parser new parseSelector: input asText) ifNil:
+ 		[self inform: 'Sorry - invalid format for the 
+ method name and arguments -- cannot accept.'.
+ 		^ false].
+ 
+ 	selector == methodSelector ifFalse:
+ 		[self inform:
+ 'You cannot change the name of
+ the method here -- it must continue
+ to be ', methodSelector.
+ 		^ false].
+ 
+ 	selector _ methodClass
+ 				compileSilently: input asText
+ 				classified: self selectedMessageCategoryName
+ 				notifying: aController
+ 				for: aPlayer.
+ 	selector == nil ifTrue: [^ false].
+ 	contents _ input asString copy.
+ 	currentCompiledMethod _ methodClass compiledMethodAt: methodSelector.
+ 	^ true!

Item was changed:
  ----- Method: MethodMorph class>>defaultNameStemForInstances (in category 'as yet unclassified') -----
  defaultNameStemForInstances
+ 	^ 'Method' translatedNoop!
- 	^ 'Method'!

Item was changed:
  ----- Method: MethodMorph>>initialize (in category 'initialization') -----
  initialize
  	"initialize the state of the receiver"
  	super initialize.
+ 	!
- 	self useRoundedCorners!

Item was added:
+ ----- Method: MethodNode>>defaultBlockType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultBlockType: t1 
+ 	^ #default!

Item was added:
+ ----- Method: MethodNode>>defaultMessageType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultMessageType
+ 	^ #none!

Item was added:
+ ----- Method: MethodNode>>firstInReceivers: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ firstInReceivers: t1 
+ 	^ t1 first!

Item was added:
+ ----- Method: MethodNode>>getAllChildren (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getAllChildren
+ 
+ 	^ arguments, (Array with: block), (temporaries ifNotNil: [temporaries] ifNil: [#()]).
+ !

Item was added:
+ ----- Method: MethodNode>>getElderSiblingOf: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getElderSiblingOf: node
+ 
+ 	| index |
+ 	temporaries ifNotNil: [
+ 		((index _ temporaries indexOf: node) > 1) ifTrue: [^ temporaries at: index - 1].
+ 		index = 1 ifTrue: [^ block].
+ 	].
+ 	node = block ifTrue: [
+ 		arguments size > 0 ifTrue: [^ arguments last].
+ 	].
+ 	((index _ arguments indexOf: node) > 1) ifTrue: [^ arguments at: index - 1].
+ 	^ nil.
+ !

Item was added:
+ ----- Method: MethodNode>>getFirstChild (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getFirstChild
+ 
+ 	arguments size > 0 ifTrue: [^ arguments first].
+ 	^ block.
+ !

Item was added:
+ ----- Method: MethodNode>>getLastChild (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getLastChild
+ 
+ 	temporaries ifNotNil: [temporaries size > 0 ifTrue: [^ temporaries last]].
+ 	^ block.
+ !

Item was added:
+ ----- Method: MethodNode>>initialBlockType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ initialBlockType
+ 	^ #none!

Item was added:
+ ----- Method: MethodNode>>initialDictForNodeInfo (in category '*Etoys-Tweak-Kedama-Generated') -----
+ initialDictForNodeInfo
+ 	^ Dictionary new!

Item was added:
+ ----- Method: MethodNode>>initialEmptyList (in category '*Etoys-Tweak-Kedama-Generated') -----
+ initialEmptyList
+ 	^ #()!

Item was added:
+ ----- Method: MethodNode>>initialFalse (in category '*Etoys-Tweak-Kedama-Generated') -----
+ initialFalse
+ 	^ false!

Item was added:
+ ----- Method: MethodNode>>initialNil (in category '*Etoys-Tweak-Kedama-Generated') -----
+ initialNil
+ 	^ nil!

Item was added:
+ ----- Method: MethodNode>>isFirstChild: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isFirstChild: childNode
+ 
+ 	arguments size > 0 ifTrue: [^ childNode = arguments first].
+ 	^ childNode = block.
+ !

Item was added:
+ ----- Method: MethodNode>>isLastChild: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isLastChild: childNode
+ 
+ 	temporaries ifNotNil: [temporaries size > 0 ifTrue: [^ childNode = temporaries last]].
+ 	^ childNode = block.
+ !

Item was added:
+ ----- Method: MethodNode>>isStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isStmt: t1 
+ 	^ t1 = #top
+ 		or: [t1 = #condition]!

Item was added:
+ ----- Method: MethodNode>>isTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTest: t1 parentNode: t2 
+ 	t1 = true
+ 		ifTrue: [^ true].
+ 	^ (t2 isMemberOf: MessageNode)
+ 		and: [t2 receiver = self
+ 				and: [t2 messageType value = #condition]]!

Item was added:
+ ----- Method: MethodNode>>isTopStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmt: t1 
+ 	t1 = nil
+ 		ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: MethodNode>>rawstart (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rawstart
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #start!

Item was added:
+ ----- Method: MethodNode>>rcvr (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr
+ 	^ true!

Item was added:
+ ----- Method: MethodNode>>rcvr: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr: t1 
+ 	^ t1!

Item was added:
+ ----- Method: MethodNode>>replaceNode:with: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ replaceNode: childNode with: newNode
+ 
+ 	| index |
+ 	(index _ arguments indexOf: childNode) > 0
+ 		ifTrue: [arguments at: index put: newNode. ^ self].
+ 	childNode = block ifTrue: [block _ newNode. ^ self].
+ 	temporaries ifNotNil: [
+ 		(index _ temporaries indexOf: childNode) > 0
+ 			ifTrue: [temporaries at: index put: newNode. ^ self].
+ 	].
+ 
+ !

Item was added:
+ ----- Method: MethodNode>>sourceMap (in category '*Etoys-Squeakland-code generation') -----
+ sourceMap
+ 	"Answer a SortedCollection of associations of the form: pc (byte offset in me) -> sourceRange (an Interval) in source text."
+ 
+ 	| methNode |
+ 	methNode _ self.
+ 	sourceText ifNil: [
+ 		"No source, use decompile string as source to map from"
+ 		methNode _ self parserClass new
+ 			parse: self decompileString
+ 			class: self methodClass
+ 	].
+ 	methNode generate: CompiledMethodTrailer empty.  "set bytecodes to map to"
+ 	^ methNode encoder sourceMap!

Item was added:
+ ----- Method: MethodNode>>start (in category '*Etoys-Tweak-Kedama-accessing') -----
+ start
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #start) value!

Item was added:
+ ----- Method: MethodNode>>start: (in category '*Etoys-Tweak-Kedama-accessing') -----
+ start: t1 
+ 	KedamaEvaluatorNodeState
+ 		stateFor: self
+ 		at: #start
+ 		put: t1!

Item was added:
+ ----- Method: MethodNode>>thisNode (in category '*Etoys-Tweak-Kedama-Generated') -----
+ thisNode
+ 	^ self!

Item was added:
+ ----- Method: MethodNode>>transfer: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 
+ 	^ t1!

Item was added:
+ ----- Method: MethodNode>>visitBy: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ visitBy: visitor
+ 
+ 	visitor visit: self.
+ 	arguments do: [:a | a visitBy: visitor].
+ 	block visitBy: visitor.
+ 	temporaries ifNotNil: [temporaries do: [:a | a visitBy: visitor]].
+ !

Item was added:
+ ----- Method: MethodReference>>decompile (in category '*Etoys-Squeakland-queries') -----
+ decompile
+ 	^ self actualClass decompile: methodSymbol!

Item was added:
+ ----- Method: MethodTempsNode>>defaultBlockType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultBlockType: t1 
+ 	^ #default!

Item was added:
+ ----- Method: MethodTempsNode>>defaultMessageType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultMessageType
+ 	^ #none!

Item was added:
+ ----- Method: MethodTempsNode>>firstInReceivers: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ firstInReceivers: t1 
+ 	^ t1 first!

Item was added:
+ ----- Method: MethodTempsNode>>isStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isStmt: t1 
+ 	^ t1 = #top
+ 		or: [t1 = #condition]!

Item was added:
+ ----- Method: MethodTempsNode>>isTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTest: t1 parentNode: t2 
+ 	t1 = true
+ 		ifTrue: [^ true].
+ 	^ (t2 isMemberOf: MessageNode)
+ 		and: [t2 receiver = self
+ 				and: [t2 messageType value = #condition]]!

Item was added:
+ ----- Method: MethodTempsNode>>isTopStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmt: t1 
+ 	t1 = nil
+ 		ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: MethodTempsNode>>rcvr: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr: t1 
+ 	^ t1!

Item was added:
+ ----- Method: MethodTempsNode>>thisNode (in category '*Etoys-Tweak-Kedama-Generated') -----
+ thisNode
+ 	^ self!

Item was added:
+ ----- Method: MethodTempsNode>>transfer: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 
+ 	^ t1!

Item was added:
+ ----- Method: MethodWithInterface>>currentScriptEditor (in category '*Etoys-Squeakland-script editor') -----
+ currentScriptEditor
+ 	"Return nil, since there  is none.  Relates to universal tiles only."
+ 
+ 	^ nil!

Item was changed:
  ----- Method: MethodWithInterface>>renameScript:fromPlayer: (in category 'rename') -----
  renameScript: newSelector fromPlayer: aPlayer
  	"The receiver's selector has changed to the new selector.  Get various things right, including the physical appearance of any Scriptor open on this method"
  
  	self allScriptEditors do:
  		[:aScriptEditor | aScriptEditor renameScriptTo: newSelector].
  
  	(selector numArgs = 0 and: [newSelector numArgs = 1])
  		ifTrue:
  			[self argumentVariables: (OrderedCollection with:
  				(Variable new name: #parameter type: #Number))].
  	(selector numArgs = 1 and: [newSelector numArgs = 0])
  		ifTrue:
  			[self argumentVariables: OrderedCollection new].
  
+ 	selector _ newSelector asSymbol.
- 	selector := newSelector asSymbol.
  	self bringUpToDate.
  	self playerClass atSelector: selector putScript: self.
+ 	self allScriptGoverningButtons  do:
- 	self allScriptActivationButtons do:
  		[:aButton | aButton bringUpToDate].
  
  !

Item was added:
+ AlignmentMorph subclass: #MidiInputMorph
+ 	instanceVariableNames: 'midiPortNumber midiSynth instrumentSelector'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sound-Scores'!
+ 
+ !MidiInputMorph commentStamp: '<historical>' prior: 0!
+ I am the user interface for a simple software MIDI synthesizer that is driven by external MIDI input. I come with controls for a single MIDI channel (channel 1), but allow channel controls for additional MIDI channels to be added by the user. The volume, pan, and instrument of each channel can be controlled independently.
+ !

Item was added:
+ ----- Method: MidiInputMorph>>addChannel (in category 'as yet unclassified') -----
+ addChannel
+ 	"Add a set of controls for another channel. Prompt the user for the channel number."
+ 
+ 	| menu existingChannels newChannel |
+ 	menu _ CustomMenu new.
+ 	existingChannels _ Set new.
+ 	1 to: 16 do: [:ch | (instrumentSelector at: ch) ifNotNil: [existingChannels add: ch]].
+ 	1 to: 16 do: [:ch |
+ 		(existingChannels includes: ch) ifFalse: [
+ 			menu add: ch printString action: ch]].
+ 	newChannel _ menu startUp.
+ 	newChannel ifNotNil: [self addChannelControlsFor: newChannel].
+ !

Item was added:
+ ----- Method: MidiInputMorph>>addChannelControlsFor: (in category 'as yet unclassified') -----
+ addChannelControlsFor: channelIndex
+ 
+ 	| r divider col |
+ 	r _ self makeRow
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #shrinkWrap.
+ 	r addMorphBack: (self channelNumAndMuteButtonFor: channelIndex).
+ 	r addMorphBack: (Morph new extent: 10 at 5; color: color).  "spacer"
+ 	r addMorphBack: (self panAndVolControlsFor: channelIndex).
+ 
+ 	divider _ AlignmentMorph new
+ 		extent: 10 at 1;
+ 		borderWidth: 1;
+ 		layoutInset: 0;
+ 		borderColor: #raised;
+ 		color: color;
+ 		hResizing: #spaceFill;
+ 		vResizing: #rigid.
+ 
+ 	col _ self lastSubmorph.
+ 	col addMorphBack: divider.
+ 	col addMorphBack: r.
+ !

Item was added:
+ ----- Method: MidiInputMorph>>atChannel:from:selectInstrument: (in category 'as yet unclassified') -----
+ atChannel: channelIndex from: aPopUpChoice selectInstrument: selection 
+ 	| oldSnd name snd instSelector |
+ 	oldSnd := midiSynth instrumentForChannel: channelIndex.
+ 	(selection beginsWith: 'edit ') 
+ 		ifTrue: 
+ 			[name := selection copyFrom: 6 to: selection size.
+ 			aPopUpChoice contentsClipped: name.
+ 			(oldSnd isKindOf: FMSound) | (oldSnd isKindOf: LoopedSampledSound) 
+ 				ifTrue: [EnvelopeEditorMorph openOn: oldSnd title: name].
+ 			(oldSnd isKindOf: SampledInstrument) 
+ 				ifTrue: [EnvelopeEditorMorph openOn: oldSnd allNotes first title: name].
+ 			^self].
+ 	snd := nil.
+ 	1 to: instrumentSelector size
+ 		do: 
+ 			[:i | 
+ 			(channelIndex ~= i and: 
+ 					[(instSelector := instrumentSelector at: i) notNil 
+ 						and: [selection = instSelector contents]]) 
+ 				ifTrue: [snd := midiSynth instrumentForChannel: i]].	"use existing instrument prototype"
+ 	snd ifNil: 
+ 			[snd := (selection = 'clink' 
+ 						ifTrue: 
+ 							[(SampledSound samples: SampledSound coffeeCupClink samplingRate: 11025)]
+ 						ifFalse: [(AbstractSound soundNamed: selection) ])copy ].
+ 	midiSynth instrumentForChannel: channelIndex put: snd.
+ 	(instrumentSelector at: channelIndex) contentsClipped: selection!

Item was added:
+ ----- Method: MidiInputMorph>>channelNumAndMuteButtonFor: (in category 'as yet unclassified') -----
+ channelNumAndMuteButtonFor: channelIndex
+ 
+ 	| muteButton instSelector r |
+ 	muteButton _ SimpleSwitchMorph new
+ 		onColor: (Color r: 1.0 g: 0.6 b: 0.6);
+ 		offColor: color;
+ 		color: color;
+ 		label: 'Mute';
+ 		target: midiSynth;
+ 		actionSelector: #mutedForChannel:put:;
+ 		arguments: (Array with: channelIndex).
+ 	instSelector _ PopUpChoiceMorph new
+ 		extent: 95 at 14;
+ 		contentsClipped: 'oboe1';
+ 		target: self;
+ 		actionSelector: #atChannel:from:selectInstrument:;
+ 		getItemsSelector: #instrumentChoicesForChannel:;
+ 		getItemsArgs: (Array with: channelIndex).
+ 	instSelector arguments:
+ 		(Array with: channelIndex with: instSelector).
+ 	instrumentSelector at: channelIndex put: instSelector.
+ 
+ 	r _ self makeRow
+ 		hResizing: #rigid;
+ 		vResizing: #spaceFill;
+ 		extent: 70 at 10.
+ 	r addMorphBack:
+ 		(StringMorph
+ 			contents: channelIndex printString
+ 			font: (TextStyle default fontOfSize: 24)).
+ 	channelIndex < 10
+ 		ifTrue: [r addMorphBack: (Morph new color: color; extent: 19 at 8)]  "spacer"
+ 		ifFalse: [r addMorphBack: (Morph new color: color; extent: 8 at 8)].  "spacer"
+ 	r addMorphBack: instSelector.
+ 	r addMorphBack: (AlignmentMorph newRow color: color).  "spacer"
+ 	r addMorphBack: muteButton.
+ 	^ r
+ !

Item was added:
+ ----- Method: MidiInputMorph>>closeMIDIPort (in category 'as yet unclassified') -----
+ closeMIDIPort
+ 
+ 	midiSynth isOn ifTrue: [midiSynth stopMIDITracking].
+ 	midiSynth closeMIDIPort.
+ !

Item was added:
+ ----- Method: MidiInputMorph>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ 	"answer the default border width for the receiver"
+ 	^ 2!

Item was added:
+ ----- Method: MidiInputMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color veryLightGray!

Item was added:
+ ----- Method: MidiInputMorph>>disableReverb: (in category 'as yet unclassified') -----
+ disableReverb: aBoolean
+ 
+ 	Preferences setPreference: #soundReverb toValue: aBoolean not
+ !

Item was added:
+ ----- Method: MidiInputMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	self listDirection: #topToBottom;
+ 	  wrapCentering: #center;
+ 		 cellPositioning: #topCenter;
+ 	  hResizing: #spaceFill;
+ 	  vResizing: #spaceFill;
+ 	  layoutInset: 3.
+ 	midiPortNumber _ nil.
+ 	midiSynth _ MIDISynth new.
+ 	instrumentSelector _ Array new: 16.
+ 	self removeAllMorphs.
+ 	self addMorphBack: self makeControls.
+ 	self addMorphBack: (AlignmentMorph newColumn color: color;
+ 			 layoutInset: 0).
+ 	self addChannelControlsFor: 1.
+ 	self extent: 20 @ 20!

Item was added:
+ ----- Method: MidiInputMorph>>instrumentChoicesForChannel: (in category 'as yet unclassified') -----
+ instrumentChoicesForChannel: channelIndex
+ 
+ 	| names inst |
+ 	names _ AbstractSound soundNames asOrderedCollection.
+ 	names _ names collect: [:n |
+ 		inst _ AbstractSound soundNamed: n.
+ 		(inst isKindOf: UnloadedSound)
+ 			ifTrue: [n, '(out)']
+ 			ifFalse: [n]].
+ 	names add: 'clink'.
+ 	names add: 'edit ', (instrumentSelector at: channelIndex) contents.
+ 	^ names asArray
+ !

Item was added:
+ ----- Method: MidiInputMorph>>invokeMenu (in category 'as yet unclassified') -----
+ invokeMenu
+ 	"Invoke a menu of additonal commands."
+ 
+ 	| aMenu |
+ 	aMenu _ CustomMenu new.
+ 	aMenu add: 'add channel' translated action: #addChannel.
+ 	aMenu add: 'reload instruments' translated target: AbstractSound selector: #updateScorePlayers.
+ 	midiSynth isOn ifFalse: [
+ 		aMenu add: 'set MIDI port' translated action: #setMIDIPort.
+ 		midiSynth midiPort
+ 			ifNotNil: [aMenu add: 'close MIDI port' translated action: #closeMIDIPort]].	
+ 	aMenu invokeOn: self defaultSelection: nil.
+ !

Item was added:
+ ----- Method: MidiInputMorph>>makeControls (in category 'as yet unclassified') -----
+ makeControls
+ 
+ 	| bb r reverbSwitch onOffSwitch |
+ 	bb _ SimpleButtonMorph new
+ 		target: self;
+ 		borderColor: #raised;
+ 		borderWidth: 2;
+ 		color: color.
+ 	r _ AlignmentMorph newRow.
+ 	r color: bb color; borderWidth: 0; layoutInset: 0.
+ 	r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5.
+ 	r addMorphBack: (
+ 		bb label: '<>';
+ 			actWhen: #buttonDown;
+ 			actionSelector: #invokeMenu).
+ 	onOffSwitch _ SimpleSwitchMorph new
+ 		offColor: color;
+ 		onColor: (Color r: 1.0 g: 0.6 b: 0.6);
+ 		borderWidth: 2;
+ 		label: 'On';
+ 		actionSelector: #toggleOnOff;
+ 		target: self;
+ 		setSwitchState: false.
+ 	r addMorphBack: onOffSwitch.
+ 	reverbSwitch _ SimpleSwitchMorph new
+ 		offColor: color;
+ 		onColor: (Color r: 1.0 g: 0.6 b: 0.6);
+ 		borderWidth: 2;
+ 		label: 'Reverb Disable';
+ 		actionSelector: #disableReverb:;
+ 		target: self;
+ 		setSwitchState: SoundPlayer isReverbOn not.
+ 	r addMorphBack: reverbSwitch.
+ 	^ r
+ !

Item was added:
+ ----- Method: MidiInputMorph>>makeRow (in category 'as yet unclassified') -----
+ makeRow
+ 
+ 	^ AlignmentMorph newRow
+ 		color: color;
+ 		layoutInset: 0;
+ 		wrapCentering: #center; cellPositioning: #leftCenter;
+ 		hResizing: #spaceFill;
+ 		vResizing: #shrinkWrap
+ !

Item was added:
+ ----- Method: MidiInputMorph>>panAndVolControlsFor: (in category 'as yet unclassified') -----
+ panAndVolControlsFor: channelIndex
+ 
+ 	| volSlider panSlider c r middleLine |
+ 	volSlider _ SimpleSliderMorph new
+ 		color: color;
+ 		extent: 101 at 2;
+ 		target: midiSynth;
+ 		arguments: (Array with: channelIndex);
+ 		actionSelector: #volumeForChannel:put:;
+ 		minVal: 0.0;
+ 		maxVal: 1.0;
+ 		adjustToValue: (midiSynth volumeForChannel: channelIndex).
+ 	panSlider _ SimpleSliderMorph new
+ 		color: color;
+ 		extent: 101 at 2;
+ 		target: midiSynth;
+ 		arguments: (Array with: channelIndex);
+ 		actionSelector: #panForChannel:put:;
+ 		minVal: 0.0;
+ 		maxVal: 1.0;		
+ 		adjustToValue: (midiSynth panForChannel: channelIndex).
+ 	c _ AlignmentMorph newColumn
+ 		color: color;
+ 		layoutInset: 0;
+ 		wrapCentering: #center; cellPositioning: #topCenter;
+ 		hResizing: #spaceFill;
+ 		vResizing: #shrinkWrap.
+ 	middleLine _ Morph new  "center indicator for pan slider"
+ 		color: (Color r: 0.4 g: 0.4 b: 0.4);
+ 		extent: 1@(panSlider height - 4);
+ 		position: panSlider center x@(panSlider top + 2).
+ 	panSlider addMorphBack: middleLine.
+ 	r _ self makeRow.
+ 	r addMorphBack: (StringMorph contents: '0').
+ 	r addMorphBack: volSlider.
+ 	r addMorphBack: (StringMorph contents: '10').
+ 	c addMorphBack: r.
+ 	r _ self makeRow.
+ 	r addMorphBack: (StringMorph contents: 'L').
+ 	r addMorphBack: panSlider.
+ 	r addMorphBack: (StringMorph contents: 'R').
+ 	c addMorphBack: r.
+ 	^ c
+ !

Item was added:
+ ----- Method: MidiInputMorph>>setMIDIPort (in category 'as yet unclassified') -----
+ setMIDIPort
+ 
+ 	| portNum |
+ 	portNum _ SimpleMIDIPort outputPortNumFromUser.
+ 	portNum ifNil: [^ self].
+ 	midiPortNumber _ portNum.
+ !

Item was added:
+ ----- Method: MidiInputMorph>>toggleOnOff (in category 'as yet unclassified') -----
+ toggleOnOff
+ 
+ 	midiSynth isOn
+ 		ifTrue: [
+ 			midiSynth stopMIDITracking]
+ 		ifFalse: [
+ 			midiPortNumber ifNil: [self setMIDIPort].
+ 			midiPortNumber ifNil: [midiPortNumber _ 0].
+ 			midiSynth midiPort: (SimpleMIDIPort openOnPortNumber: midiPortNumber).
+ 			midiSynth startMIDITracking].
+ !

Item was added:
+ ----- Method: MidiInputMorph>>updateInstrumentsFromLibraryExcept: (in category 'as yet unclassified') -----
+ updateInstrumentsFromLibraryExcept: soundsBeingEdited
+ 	"The instrument library has been modified. Update my instruments with the new versions from the library. Use a single instrument prototype for all parts with the same name; this allows the envelope editor to edit all the parts by changing a single sound prototype."
+ 
+ 	"soundsBeingEdited is a collection of sounds being edited (by an EnvelopeEditor).  If any of my instruments share one of these, then they will be left alone so as not to disturb that dynamic linkage."
+ 
+ 	| unloadPostfix myInstruments name displaysAsUnloaded isUnloaded |
+ 	unloadPostfix _ '(out)'.
+ 	myInstruments _ Dictionary new.
+ 	1 to: instrumentSelector size do: [:i |
+ 		name _ (instrumentSelector at: i) contents.
+ 		displaysAsUnloaded _ name endsWith: unloadPostfix.
+ 		displaysAsUnloaded ifTrue: [
+ 			name _ name copyFrom: 1 to: name size - unloadPostfix size].
+ 		(myInstruments includesKey: name) ifFalse: [
+ 			myInstruments at: name put:
+ 				(name = 'clink'
+ 					ifTrue: [
+ 						(SampledSound
+ 							samples: SampledSound coffeeCupClink
+ 							samplingRate: 11025) copy]
+ 					ifFalse: [
+ 						(AbstractSound
+ 							soundNamed: name
+ 							ifAbsent: [
+ 								(instrumentSelector at: i) contentsClipped: 'default'.
+ 								FMSound default]) copy])].
+ 		(soundsBeingEdited includes: (midiSynth instrumentForChannel: i)) ifFalse:
+ 			["Do not update any instrument that is currently being edited"
+ 			midiSynth instrumentForChannel: i put: (myInstruments at: name)].
+ 
+ 		"update loaded/unloaded status in instrumentSelector if necessary"
+ 		isUnloaded _ (myInstruments at: name) isKindOf: UnloadedSound.
+ 		(displaysAsUnloaded and: [isUnloaded not])
+ 			ifTrue: [(instrumentSelector at: i) contentsClipped: name].
+ 		(displaysAsUnloaded not and: [isUnloaded])
+ 			ifTrue: [(instrumentSelector at: i) contentsClipped: name, unloadPostfix]].
+ !

Item was added:
+ AlignmentMorph subclass: #Mines
+ 	instanceVariableNames: 'board minesDisplay timeDisplay helpText'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!

Item was added:
+ ----- Method: Mines class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName: 	'Mines' translatedNoop
+ 		categories:		{'Games' translatedNoop}
+ 		documentation:	'Find those mines' translatedNoop!

Item was added:
+ ----- Method: Mines>>board (in category 'access') -----
+ board
+ 
+ 	board ifNil:
+ 		[board _ MinesBoard new
+ 			target: self;
+ 			actionSelector: #selection].
+ 	^ board!

Item was added:
+ ----- Method: Mines>>buildButton:target:label:selector: (in category 'initialize') -----
+ buildButton: aButton target: aTarget label: aLabel selector: aSelector
+ 	"wrap a button or switch in an alignmentMorph to allow a row of buttons to fill space"
+ 
+ 	| a |
+ 	aButton 
+ 		target: aTarget;
+ 		label: aLabel;
+ 		actionSelector: aSelector;
+ 		borderColor: #raised;
+ 		borderWidth: 2;
+ 		color: color.
+ 	a _ AlignmentMorph newColumn
+ 		wrapCentering: #center; cellPositioning: #topCenter;
+ 		hResizing: #spaceFill;
+ 		vResizing: #shrinkWrap;
+ 		color: color.
+ 	a addMorph: aButton.
+ 	^ a
+ 
+ !

Item was added:
+ ----- Method: Mines>>defaultBorderColor (in category 'initialization') -----
+ defaultBorderColor
+ 	"answer the default border color/fill style for the receiver"
+ 	^ #raised!

Item was added:
+ ----- Method: Mines>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ 	"answer the default border width for the receiver"
+ 	^ 2!

Item was added:
+ ----- Method: Mines>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color lightGray!

Item was added:
+ ----- Method: Mines>>help: (in category 'actions') -----
+ help: helpState
+ 
+ 	helpState
+ 		ifTrue: [self addMorphBack: self helpText]
+ 		ifFalse: [helpText delete]!

Item was added:
+ ----- Method: Mines>>helpString (in category 'access') -----
+ helpString
+ 	^ 'Mines is a quick and dirty knock-off of the Minesweeper game found on Windows. I used this to teach myself Squeak. I liberally borrowed from the <SameGame> example, so the code should look pretty familiar, though like any project it has rapidly ...morphed... to reflect my own idiosyncracies. Note especially the lack of any idiomatic structure to the code - I simply haven''t learned them yet.
+ 
+ Mines is a very simple, yet extremely frustrating, game to play. The rules are just this: there are 99 mines laid down on the board. Find them without ""finding"" them. Your first tile is free - click anywhere. The tiles will tell you how many mines are right next to it, including the diagonals. If you uncover the number ''2'', you know that there are two mines hidden in the adjacent tiles. If you think you have found a mine, you can flag it by either ''shift'' clicking, or click with the ''yellow'' mouse button. Once you have flagged all of the mines adjacent to a numbered tile, you can click on the tile again to uncover the rest. Of course, you could be wrong about those too... 
+ 
+ You win once you have uncovered all of the tiles that do not contain mines. Good luck...
+ 
+ David A. Smith
+ dastrs at bellsouth.net' translated!

Item was added:
+ ----- Method: Mines>>helpText (in category 'access') -----
+ helpText
+ 
+ 	helpText ifNil:
+ 		[helpText _ PluggableTextMorph new
+ 			width: self width; "board width;"
+ 			editString: self helpString].
+ 	^ helpText!

Item was added:
+ ----- Method: Mines>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	self listDirection: #topToBottom;
+ 	  wrapCentering: #center;
+ 		 cellPositioning: #topCenter;
+ 	  vResizing: #shrinkWrap;
+ 	  hResizing: #shrinkWrap;
+ 	  layoutInset: 3;
+ 	  addMorph: self makeControls;
+ 	  addMorph: self board.
+ 	helpText _ nil.
+ 	self newGame!

Item was added:
+ ----- Method: Mines>>makeControls (in category 'initialize') -----
+ makeControls
+ 	| row |
+ 	row := AlignmentMorph newRow color: color;
+ 				 borderWidth: 2;
+ 				 layoutInset: 3.
+ 	row borderColor: #inset.
+ 	row hResizing: #spaceFill;
+ 		 vResizing: #shrinkWrap;
+ 		 wrapCentering: #center;
+ 		 cellPositioning: #leftCenter;
+ 		 extent: 5 @ 5.
+ 	row
+ 		addMorph: (self
+ 				buildButton: SimpleSwitchMorph new
+ 				target: self
+ 				label: '  Help  ' translated
+ 				selector: #help:).
+ 	row
+ 		addMorph: (self
+ 				buildButton: SimpleButtonMorph new
+ 				target: self
+ 				label: '  Quit  ' translated
+ 				selector: #delete).
+ 	"row 
+ 	addMorph: (self 
+ 	buildButton: SimpleButtonMorph new 
+ 	target: self 
+ 	label: ' Hint '  translated
+ 	selector: #hint)."
+ 	row
+ 		addMorph: (self
+ 				buildButton: SimpleButtonMorph new
+ 				target: self
+ 				label: '  New game  ' translated
+ 				selector: #newGame).
+ 	minesDisplay := LedMorph new digits: 2;
+ 				 extent: 2 * 10 @ 15.
+ 	row
+ 		addMorph: (self wrapPanel: minesDisplay label: 'Mines:' translated).
+ 	timeDisplay := LedTimerMorph new digits: 3;
+ 				 extent: 3 * 10 @ 15.
+ 	row
+ 		addMorph: (self wrapPanel: timeDisplay label: 'Time:' translated).
+ 	^ row!

Item was added:
+ ----- Method: Mines>>minesDisplay (in category 'access') -----
+ minesDisplay
+ 
+ 	^ minesDisplay!

Item was added:
+ ----- Method: Mines>>newGame (in category 'actions') -----
+ newGame
+ 
+ 	timeDisplay value: 0; flash: false.
+ 	timeDisplay stop.
+ 	timeDisplay reset.
+ 	minesDisplay value: 99.
+ 	self board resetBoard.!

Item was added:
+ ----- Method: Mines>>timeDisplay (in category 'access') -----
+ timeDisplay
+ 
+ 	^ timeDisplay!

Item was added:
+ ----- Method: Mines>>wrapPanel:label: (in category 'initialize') -----
+ wrapPanel: anLedPanel label: aLabel
+ 	"wrap an LED panel in an alignmentMorph with a label to its left"
+ 
+ 	| a |
+ 	a _ AlignmentMorph newRow
+ 		wrapCentering: #center; cellPositioning: #leftCenter;
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #shrinkWrap;
+ 		borderWidth: 0;
+ 		layoutInset: 3;
+ 		color: color lighter.
+ 	a addMorph: anLedPanel.
+ 	a addMorph: (StringMorph contents: aLabel). 
+ 	^ a
+ !

Item was added:
+ AlignmentMorph subclass: #MinesBoard
+ 	instanceVariableNames: 'protoTile rows columns flashCount tileCount target actionSelector arguments gameStart gameOver'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!

Item was added:
+ ----- Method: MinesBoard class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 
+ 	^false!

Item was added:
+ ----- Method: MinesBoard>>actionSelector (in category 'accessing') -----
+ actionSelector
+ 
+ 	^ actionSelector!

Item was added:
+ ----- Method: MinesBoard>>actionSelector: (in category 'accessing') -----
+ actionSelector: aSymbolOrString
+ 
+ 	(nil = aSymbolOrString or:
+ 	 ['nil' = aSymbolOrString or:
+ 	 [aSymbolOrString isEmpty]])
+ 		ifTrue: [^ actionSelector _ nil].
+ 
+ 	actionSelector _ aSymbolOrString asSymbol.
+ !

Item was added:
+ ----- Method: MinesBoard>>adjustTiles (in category 'accessing') -----
+ adjustTiles
+ 	"reset tiles"
+ 
+ 	| newSubmorphs count r c |
+ 
+ 	submorphs do: "clear out all of the tiles."
+ 		[:m | m privateOwner: nil].
+ 
+ 	newSubmorphs _ OrderedCollection new.
+ 
+ 	r _ 0.
+ 	c _ 0.
+ 	count _ columns * rows.
+ 
+ 	1 to: count do:
+ 				[:m |
+ 				newSubmorphs add:
+ 					(protoTile copy
+ 						position: self position + (self protoTile extent * (c @ r));
+ 						actionSelector: #tileClickedAt:newSelection:modifier:;
+ 						arguments: (Array with: (c+1) @ (r+1));
+ 						target: self;
+ 						privateOwner: self).
+ 				c _ c + 1.
+ 				c >= columns ifTrue: [c _ 0. r _ r + 1]].
+ 	submorphs _ newSubmorphs asArray.
+ 
+ !

Item was added:
+ ----- Method: MinesBoard>>blowUp (in category 'actions') -----
+ blowUp
+ 	owner timeDisplay stop.
+ 	self submorphsDo:
+ 		[:m |
+ 		m isMine ifTrue:
+ 				[m switchState: true.].
+ 		].
+ 	flashCount _ 2.
+ 	gameOver _ true.!

Item was added:
+ ----- Method: MinesBoard>>clearMines: (in category 'actions') -----
+ clearMines: location
+ 
+ 	| al tile |
+ 
+ 	(self countFlags: location) = (self findMines: location) ifTrue:
+ 		[
+ 		{-1 at -1. -1 at 0. -1 at 1. 0 at 1. 1 at 1. 1 at 0. 1 at -1. 0 at -1} do:
+ 			[:offsetPoint |
+ 			al _ location + offsetPoint.
+ 			((al x between: 1 and: columns) and: [al y between: 1 and: rows]) ifTrue: [
+ 				tile _ self tileAt: al.
+ 				(tile mineFlag or: [tile switchState]) ifFalse:[
+ 		   		self stepOnTile: al].].].
+ 		].!

Item was added:
+ ----- Method: MinesBoard>>countFlags: (in category 'actions') -----
+ countFlags: location
+ 
+ 	| al at flags |
+ 	flags _ 0.
+ 	{-1 at -1. -1 at 0. -1 at 1. 0 at 1. 1 at 1. 1 at 0. 1 at -1. 0 at -1} do:
+ 		[:offsetPoint |
+ 		al _ location + offsetPoint.
+ 		((al x between: 1 and: columns) and: [al y between: 1 and: rows]) ifTrue:
+ 			[at _ self tileAt: al.
+ 			(at mineFlag ) ifTrue:
+ 				[flags _ flags+1]]].
+ 		^flags.!

Item was added:
+ ----- Method: MinesBoard>>defaultBorderColor (in category 'initialization') -----
+ defaultBorderColor
+ 	"answer the default border color/fill style for the receiver"
+ 	^ #inset!

Item was added:
+ ----- Method: MinesBoard>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ 	"answer the default border width for the receiver"
+ 	^ 2!

Item was added:
+ ----- Method: MinesBoard>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color lightGray!

Item was added:
+ ----- Method: MinesBoard>>extent: (in category 'geometry') -----
+ extent: aPoint
+ 	"constrain the extent to be a multiple of the protoTile size during resizing"
+ 	super extent: (aPoint truncateTo: protoTile extent).!

Item was added:
+ ----- Method: MinesBoard>>findMines: (in category 'actions') -----
+ findMines: location
+ 
+ 	| al at mines |
+ 	mines _ 0.
+ 	{-1 at -1. -1 at 0. -1 at 1. 0 at 1. 1 at 1. 1 at 0. 1 at -1. 0 at -1} do:
+ 		[:offsetPoint |
+ 		al _ location + offsetPoint.
+ 		((al x between: 1 and: columns) and: [al y between: 1 and: rows]) ifTrue:
+ 			[at _ self tileAt: al.
+ 			(at isMine ) ifTrue:
+ 				[mines _ mines+1]]].
+ 		^mines.!

Item was added:
+ ----- Method: MinesBoard>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	target _ nil.
+ 	actionSelector _ #selection.
+ 	arguments _ #().
+ 	""
+ 	self layoutPolicy: nil;
+ 	  hResizing: #rigid;
+ 	  vResizing: #rigid.
+ 	""
+ 	rows _ self preferredRows.
+ 	columns _ self preferredColumns.
+ 	flashCount _ 0.
+ 	""
+ 	self extent: self protoTile extent * (columns @ rows).
+ 	self adjustTiles.
+ 	self resetBoard!

Item was added:
+ ----- Method: MinesBoard>>preferredColumns (in category 'preferences') -----
+ preferredColumns
+ 
+ 	^ 30!

Item was added:
+ ----- Method: MinesBoard>>preferredMines (in category 'preferences') -----
+ preferredMines
+ 
+ 	^ 99!

Item was added:
+ ----- Method: MinesBoard>>preferredRows (in category 'preferences') -----
+ preferredRows
+ 
+ 	^ 16!

Item was added:
+ ----- Method: MinesBoard>>protoTile (in category 'accessing') -----
+ protoTile
+ 
+ 	protoTile ifNil: [protoTile _ MinesTile new].
+ 	^ protoTile!

Item was added:
+ ----- Method: MinesBoard>>protoTile: (in category 'accessing') -----
+ protoTile: aTile
+ 
+ 	protoTile _ aTile!

Item was added:
+ ----- Method: MinesBoard>>resetBoard (in category 'initialization') -----
+ resetBoard
+ 
+ 	gameStart _ false.
+ 	gameOver _ false.
+ 	[flashCount = 0] whileFalse: [self step].
+ 	flashCount _ 0.
+ 	tileCount _ 0.
+ 	Collection initialize.  "randomize the Collection class"
+ 	self purgeAllCommands.
+ 	self submorphsDo: "set tiles to original state."
+ 		[:m | m privateOwner: nil.  "Don't propagate all these changes..."
+ 		m mineFlag: false.
+ 		m disabled: false.
+ 		m switchState: false.
+ 		m isMine: false.
+ 		m privateOwner: self].
+ 	self changed  "Now note the change in bulk"!

Item was added:
+ ----- Method: MinesBoard>>selectTilesAdjacentTo: (in category 'actions') -----
+ selectTilesAdjacentTo: location
+ 
+ 	| al at mines |
+ "	{-1 at 0. 0 at -1. 1 at 0. 0 at 1} do:"
+ 	{-1 at -1. -1 at 0. -1 at 1. 0 at 1. 1 at 1. 1 at 0. 1 at -1. 0 at -1} do:
+ 		[:offsetPoint |
+ 		al _ location + offsetPoint.
+ 		((al x between: 1 and: columns) and: [al y between: 1 and: rows]) ifTrue:
+ 			[at _ self tileAt: al.
+ 			(at switchState not and: [at disabled not]) ifTrue:
+ 				[
+ 				mines _ (self tileAt: al) nearMines.
+ 				at mineFlag ifTrue: [at mineFlag: false.].  "just in case we flagged it as a mine."
+ 				at switchState: true.
+ 				tileCount _ tileCount + 1.
+ 				mines=0 ifTrue: [self selectTilesAdjacentTo: al]]]]
+ !

Item was added:
+ ----- Method: MinesBoard>>setMines: (in category 'initialization') -----
+ setMines: notHere
+ 
+ 	| count total c r sm |
+ 	count _ 0.
+ 	total _ self preferredMines.
+ 	[count < total] whileTrue:[
+ 		c _ columns atRandom.
+ 		r _ rows atRandom.
+ 		c at r = notHere ifFalse: [
+ 			sm _ self tileAt: c at r.
+ 			sm isMine ifFalse: [
+ 				"sm color: Color red lighter lighter lighter lighter."
+ 				sm isMine: true.
+ 				count _ count + 1.]]
+ 		].
+ 	1 to: columns do: [ :col |
+ 		1 to: rows do: [ :row |
+ 			(self tileAt: col @ row) nearMines: (self findMines: (col @ row))
+ 			]].
+ 			!

Item was added:
+ ----- Method: MinesBoard>>step (in category 'stepping and presenter') -----
+ step
+ 
+ 	flashCount = 0 ifFalse: [
+ 		self submorphsDo:
+ 			[:m |
+ 				m color: m color negated.].
+ 			flashCount _ flashCount - 1.
+ 			].
+ !

Item was added:
+ ----- Method: MinesBoard>>stepOnTile: (in category 'actions') -----
+ stepOnTile: location
+ 
+ 	| mines tile |
+ 	tile _ self tileAt: location.
+ 	tile mineFlag ifFalse:[
+ 		tile isMine ifTrue: [tile color: Color gray darker darker. self blowUp. ^false.]
+ 			ifFalse:[
+ 				mines _ self findMines: location.
+ 				tile switchState: true.
+ 				tileCount _ tileCount + 1.
+ 				mines = 0 ifTrue: 
+ 					[self selectTilesAdjacentTo: location]].
+ 		tileCount = ((columns*rows) - self preferredMines) ifTrue:[ gameOver _ true. flashCount _ 2. 	owner timeDisplay stop.].
+ 		^ true.] 
+ 		ifTrue: [^ false.]
+ 
+ !

Item was added:
+ ----- Method: MinesBoard>>stepTime (in category 'testing') -----
+ stepTime
+ 
+ 	^ 300!

Item was added:
+ ----- Method: MinesBoard>>target (in category 'accessing') -----
+ target
+ 
+ 	^ target!

Item was added:
+ ----- Method: MinesBoard>>target: (in category 'accessing') -----
+ target: anObject
+ 
+ 	target _ anObject!

Item was added:
+ ----- Method: MinesBoard>>tileAt: (in category 'accessing') -----
+ tileAt: aPoint
+ 
+ 	^ submorphs at: (aPoint x + ((aPoint y - 1) * columns))!

Item was added:
+ ----- Method: MinesBoard>>tileClickedAt:newSelection:modifier: (in category 'actions') -----
+ tileClickedAt: location newSelection: isNewSelection modifier: mod
+ 	| tile |
+ 	"self halt."
+ 	gameOver ifTrue: [^ false].
+ 	tile _ self tileAt: location.
+ 
+ 	isNewSelection ifFalse: [
+ 		mod ifTrue: [
+ 				tile mineFlag: ((tile mineFlag) not).
+ 				tile mineFlag ifTrue: [owner minesDisplay value: (owner minesDisplay value - 1)]
+ 						ifFalse: [owner minesDisplay value: (owner minesDisplay value + 1)].
+ 				^ true.].
+ 
+ 		gameStart ifFalse: [ 
+ 			self setMines: location.
+ 			gameStart _ true. 
+ 			owner timeDisplay start.].
+ 		^ self stepOnTile: location.
+ 		]
+ 	ifTrue:[ self clearMines: location.].!

Item was added:
+ SimpleSwitchMorph subclass: #MinesTile
+ 	instanceVariableNames: 'switchState disabled oldSwitchState isMine nearMines palette mineFlag'
+ 	classVariableNames: 'PreferredColor'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!

Item was added:
+ ----- Method: MinesTile class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 
+ 	^false!

Item was added:
+ ----- Method: MinesTile>>color: (in category 'accessing') -----
+ color: aColor 
+ 	super color: aColor.
+ 	onColor _ aColor.
+ 	offColor _ aColor.
+ 	self changed!

Item was added:
+ ----- Method: MinesTile>>disabled (in category 'accessing') -----
+ disabled
+ 
+ 	^ disabled
+ !

Item was added:
+ ----- Method: MinesTile>>disabled: (in category 'accessing') -----
+ disabled: aBoolean
+ 
+ 	disabled _ aBoolean.
+ 	disabled
+ 		ifTrue:
+ 			[self color: owner color.
+ 			self borderColor: owner color]
+ 		ifFalse:
+ 			[self setSwitchState: self switchState]!

Item was added:
+ ----- Method: MinesTile>>doButtonAction: (in category 'accessing') -----
+ doButtonAction: modifier 
+ 	"Perform the action of this button. The first argument of the message sent to the target is the current state of this switch, 
+ 	the second argument is the modifier button state."
+ 
+ 	(target notNil and: [actionSelector notNil]) 
+ 		ifTrue: 
+ 			[^target perform: actionSelector
+ 				withArguments: ((arguments copyWith: switchState) copyWith: modifier)]!

Item was added:
+ ----- Method: MinesTile>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas 
+ 	"Draw a rectangle with a solid, inset, or raised border.
+ 	Note: the raised border color *and* the inset border color are generated
+ 	from the receiver's own color, instead of having the inset border color
+ 	generated from the owner's color, as in BorderedMorph."
+ 
+ 	| font rct |
+ 
+ 	borderWidth = 0 ifTrue: [  "no border"
+ 		aCanvas fillRectangle: bounds color: color.
+ 		^ self.].
+ 
+ 	borderColor == #raised ifTrue: [
+ 		^ aCanvas frameAndFillRectangle: bounds
+ 			fillColor: color
+ 			borderWidth: borderWidth
+ 			topLeftColor: color lighter lighter
+ 			bottomRightColor: color darker darker darker].
+ 
+ 	borderColor == #inset ifTrue: [
+ 		aCanvas frameAndFillRectangle: bounds
+ 			fillColor: color
+ 			borderWidth: 1 " borderWidth"
+ 			topLeftColor: (color darker darker darker)
+ 			bottomRightColor: color lighter.
+ 		self isMine ifTrue: [  
+ 			font  _ StrikeFont familyName: 'Atlanta' size: 22 emphasized: 1.
+ 			rct _ bounds insetBy: ((bounds width) - (font widthOfString: '*'))/2 at 0.
+ 			rct _ rct top: rct top + 1.
+ 			aCanvas drawString: '*' in: (rct translateBy: 1 at 1) font: font color: Color black.
+ 			^ aCanvas drawString: '*' in: rct font: font color: Color red .].
+ 		self nearMines > 0 ifTrue: [ 
+ 			font _ StrikeFont familyName: 'ComicBold' size: 22 emphasized: 1.
+ 			rct _ bounds insetBy: ((bounds width) - (font widthOfString: nearMines asString))/2 at 0.
+ 			rct _ rct top: rct top + 1.
+ 			aCanvas drawString: nearMines asString in: (rct translateBy: 1 at 1) font: font color: Color black.
+ 			^ aCanvas drawString: nearMines asString in: rct font: font color: ((palette at: nearMines) ) .].
+ 		^self. ].
+ 
+ 	"solid color border"
+ 	aCanvas frameAndFillRectangle: bounds
+ 		fillColor: color
+ 		borderWidth: borderWidth
+ 		borderColor: borderColor.!

Item was added:
+ ----- Method: MinesTile>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	super initialize.
+ 	self label: ''.
+ 	self borderWidth: 3.
+ 	bounds _ 0 at 0 corner: 20 at 20.
+ 	offColor _ self preferredColor.
+ 	onColor _ self preferredColor.
+ 	switchState _ false.
+ 	oldSwitchState _ false.
+ 	disabled _ false.
+ 	isMine _ false.
+ 	nearMines _ 0.
+ 	self useSquareCorners.
+ 	palette _ (Color wheel: 8) asOrderedCollection reverse.
+ "	flashColor _ palette removeLast."
+ !

Item was added:
+ ----- Method: MinesTile>>isMine (in category 'accessing') -----
+ isMine
+ 
+ 	^ isMine!

Item was added:
+ ----- Method: MinesTile>>isMine: (in category 'accessing') -----
+ isMine: aBoolean
+ 
+ 	isMine _ aBoolean.
+ !

Item was added:
+ ----- Method: MinesTile>>mineFlag (in category 'accessing') -----
+ mineFlag
+ 
+ 	^ mineFlag.
+ !

Item was added:
+ ----- Method: MinesTile>>mineFlag: (in category 'accessing') -----
+ mineFlag: boolean
+ 
+ 	mineFlag _ boolean.
+ 	mineFlag ifTrue: [
+ 		self color: Color red lighter lighter lighter lighter.]
+ 		ifFalse: [
+ 		self color: self preferredColor.].
+ 	^ mineFlag.
+ !

Item was added:
+ ----- Method: MinesTile>>mouseDown: (in category 'event handling') -----
+ mouseDown: evt
+  	"The only real alternative mouse clicks are the yellow button or the shift key. I will treat them as the same thing, and ignore two button presses for now. I am keeping this code around, because it is the only documentation I have of MouseButtonEvent."
+ 	| mod |
+ "	Transcript show: 'anyModifierKeyPressed - '; show: evt anyModifierKeyPressed printString ; cr;
+ 			 show: 'commandKeyPressed - '; show: evt commandKeyPressed printString ;  cr;
+ 			 show: 'controlKeyPressed - '; show:evt controlKeyPressed printString ; cr;
+ 			 show: 'shiftPressed - '; show: evt shiftPressed printString ; cr;
+ 			 show: 'buttons - '; show: evt buttons printString ; cr;
+ 			 show: 'handler - '; show: evt handler printString ;  cr;
+ 			 show: 'position - '; show: evt position printString ; cr;
+ 			 show: 'type - '; show: evt type printString ; cr;
+ 			 show: 'anyButtonPressed - '; show: evt anyButtonPressed printString ; cr;
+ 			 show: 'blueButtonPressed - '; show: evt blueButtonPressed printString ; cr;
+ 			 show: 'redButtonPressed - '; show: evt redButtonPressed printString ; cr;
+ 			 show: 'yellowButtonPressed - '; show: evt yellowButtonPressed printString ; cr; cr; cr."
+ 			
+ 	
+ 	mod _  (evt yellowButtonPressed) | (evt shiftPressed). 
+ 	switchState ifFalse:[
+ 		(self doButtonAction: mod) ifTrue:
+ 			[mod ifFalse: [ self setSwitchState: true. ].].
+ 	] ifTrue: [
+ 			self doButtonAction: mod.].!

Item was added:
+ ----- Method: MinesTile>>mouseMove: (in category 'event handling') -----
+ mouseMove: evt
+ 
+ 	"don't do anything, here"!

Item was added:
+ ----- Method: MinesTile>>mouseUp: (in category 'event handling') -----
+ mouseUp: evt
+ 
+ 	"don't do anything, here"!

Item was added:
+ ----- Method: MinesTile>>nearMines (in category 'accessing') -----
+ nearMines
+ 
+ 	^ nearMines.
+ !

Item was added:
+ ----- Method: MinesTile>>nearMines: (in category 'accessing') -----
+ nearMines: nMines
+ 
+ 	nearMines _ nMines.
+ !

Item was added:
+ ----- Method: MinesTile>>preferredColor (in category 'initialization') -----
+ preferredColor
+ 		"PreferredColor _ nil  <-- to reset cache"
+ 	PreferredColor ifNil:
+ 		["This actually takes a while to compute..."
+ 		PreferredColor _ Color gray lighter lighter lighter].
+ 	^ PreferredColor!

Item was added:
+ ----- Method: MinesTile>>switchState (in category 'accessing') -----
+ switchState
+ 
+ 	^ switchState!

Item was added:
+ ----- Method: MinesTile>>switchState: (in category 'accessing') -----
+ switchState: aBoolean
+ 
+ 	switchState _ aBoolean.
+ 	disabled ifFalse:
+ 		[switchState
+ 			ifTrue:[
+ 				"flag ifTrue: [self setFlag]." "if this is a flagged tile, unflag it."
+ 				self borderColor: #inset.
+ 				self color: onColor]
+ 			ifFalse:[
+ 				self borderColor: #raised.
+ 				self color: offColor]]!

Item was added:
+ NewVariableDialogMorph subclass: #ModifyVariableDialogMorph
+ 	instanceVariableNames: 'slot'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Scripting'!

Item was added:
+ ----- Method: ModifyVariableDialogMorph class>>on:slot: (in category 'as yet unclassified') -----
+ on: aMorph slot: aByteSymbol
+ 	^ self basicNew initializeWith: aMorph slot: aByteSymbol!

Item was added:
+ ----- Method: ModifyVariableDialogMorph>>chooseType (in category 'accessing') -----
+ chooseType
+ 	(self targetPlayer okayToRemoveSlotNamed: slot) ifFalse:
+ 		[^ self inform: ('Sorry, {1} is in
+ use in a script.' translated format: {slot})].
+ 	super chooseType!

Item was added:
+ ----- Method: ModifyVariableDialogMorph>>doAccept (in category 'actions') -----
+ doAccept
+ 	| newName |
+ 	self delete.
+ 	self varName isEmpty ifTrue: [^ self].
+ 	"If the original slot was modified while this dialog was still open, we add a new variable"
+ 	(self targetPlayer slotInfo includesKey: slot)
+ 		ifFalse: [self addNewVariable.
+ 			^ self].
+ 	"Change slot type"
+ 	self varType = (self targetPlayer typeForSlot: slot)
+ 		ifFalse: [self targetPlayer
+ 					changeSlotTypeOf: slot
+ 					to: self varType].
+ 	"Change slot name"
+ 	(newName := self varAcceptableName) = slot
+ 		ifFalse: [self targetPlayer
+ 					renameSlot: slot
+ 					newSlotName: newName].
+ 	"Change decimal places"
+ 	(#(#Number #Point) includes: self varType)
+ 		ifTrue: [
+ 			self targetPlayer
+ 				setPrecisionFor: newName
+ 				precision: self decimalPlaces]!

Item was added:
+ ----- Method: ModifyVariableDialogMorph>>initializeWith:slot: (in category 'initialization') -----
+ initializeWith: aMorph slot: aSymbolOrNil
+ 	myTarget := aMorph.
+ 	slot := aSymbolOrNil.
+ 	self initialize!

Item was added:
+ ----- Method: ModifyVariableDialogMorph>>title (in category 'accessing') -----
+ title
+ 	^ 'Modify variable' translated!

Item was added:
+ ----- Method: ModifyVariableDialogMorph>>varAcceptableName (in category 'accessing') -----
+ varAcceptableName
+ 	^ ScriptingSystem
+ 		acceptableSlotNameFrom: self varName
+ 		forSlotCurrentlyNamed: slot
+ 		asSlotNameIn: self targetPlayer
+ 		world: self targetPlayer costume world!

Item was added:
+ ----- Method: ModifyVariableDialogMorph>>varName (in category 'accessing') -----
+ varName
+ 	^ varNameText
+ 		ifNil: [slot]
+ 		ifNotNil: [:text | text contents string]!

Item was added:
+ ----- Method: ModifyVariableDialogMorph>>varType (in category 'accessing') -----
+ varType
+ 	"Answer the symbol representing the chosen value type for the variable."
+ 
+ 	^ varTypeButton
+ 		ifNil: [self targetPlayer typeForSlot: slot]
+ 		ifNotNil: [:button| 
+ 			Vocabulary typeChoicesForUserVariables
+ 				detect: [:each |
+ 					each translated = button label]
+ 				ifNone: [button label asSymbol]]!

Item was added:
+ AlignmentMorph subclass: #MonthMorph
+ 	instanceVariableNames: 'month todayCache tileRect model'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-PDA'!
+ 
+ !MonthMorph commentStamp: '<historical>' prior: 0!
+ A widget that displays the dates of a month in a table.!

Item was added:
+ ----- Method: MonthMorph class>>newWithModel: (in category 'as yet unclassified') -----
+ newWithModel: aModel
+ 	^ (self basicNew model: aModel) initialize!

Item was added:
+ ----- Method: MonthMorph>>addCustomMenuItems:hand: (in category 'all') -----
+ addCustomMenuItems: aCustomMenu hand: aHandMorph
+ 	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ 	aCustomMenu 
+ 		addLine;
+ 		addUpdating: #startMondayOrSundayString action: #toggleStartMonday;
+ 		add: 'jump to year...' translated action: #chooseYear.!

Item was added:
+ ----- Method: MonthMorph>>chooseYear (in category 'controls') -----
+ chooseYear
+ 
+ 	| newYear yearString |
+ 	newYear _ (SelectionMenu selections:
+ 					{'today'} , (month year - 5 to: month year + 5) , {'other...'})
+ 						startUpWithCaption: 'Choose another year' translated.
+ 	newYear ifNil: [^ self].
+ 	newYear isNumber ifTrue:
+ 		[^ self month: (Month month: month monthName year: newYear)].
+ 	newYear = 'today' ifTrue:
+ 		[^ self month: (Month starting: Date today)].
+ 	yearString _ FillInTheBlank 
+ 					request: 'Type in a year' translated initialAnswer: Date today year asString.
+ 	yearString ifNil: [^ self].
+ 	newYear _ yearString asNumber.
+ 	(newYear between: 0 and: 9999) ifTrue:
+ 		[^ self month: (Month month: month monthName year: newYear)].
+ !

Item was added:
+ ----- Method: MonthMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 
+ 	^ Color red!

Item was added:
+ ----- Method: MonthMorph>>highlightToday (in category 'initialization') -----
+ highlightToday
+ 
+ 	todayCache _ Date today.
+ 	self allMorphsDo:
+ 		[:m | (m isKindOf: SimpleSwitchMorph) ifTrue:
+ 				[(m arguments isEmpty not and: [m arguments first = todayCache])
+ 					ifTrue: [m borderWidth: 2; borderColor: Color yellow]
+ 					ifFalse: [m borderWidth: 1; setSwitchState: m color = m onColor]]].
+ 
+ !

Item was added:
+ ----- Method: MonthMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	tileRect _ 0 @ 0 extent: 23 @ 19.
+ 	self 
+ 		layoutInset: 1;
+ 		listDirection: #topToBottom;
+ 		vResizing: #shrinkWrap;
+ 		hResizing: #shrinkWrap;
+ 		month: Month current.
+ 
+ 	self rubberBandCells: false.
+ 	self extent: 160 @ 130!

Item was added:
+ ----- Method: MonthMorph>>initializeHeader (in category 'initialization') -----
+ initializeHeader
+ 	| title sep frame button monthName |
+ 	title := (self findA: WeekMorph) title.
+ 	title hResizing: #spaceFill.
+ 	"should be done by WeekMorph but isn't"
+ 	title submorphsDo: [:m | m hResizing: #spaceFill].
+ 	monthName := month name.
+ 	self width < 160 
+ 		ifTrue: 
+ 			[monthName := (#(6 7 9) includes: month index) 
+ 				ifTrue: [monthName copyFrom: 1 to: 4]
+ 				ifFalse: [monthName copyFrom: 1 to: 3]].
+ 	sep := (Morph new)
+ 				color: Color transparent;
+ 				extent: title width @ 1.
+ 	self
+ 		addMorph: sep;
+ 		addMorph: title;
+ 		addMorph: sep copy.
+ 	button := (SimpleButtonMorph new)
+ 				target: self;
+ 				actWhen: #whilePressed;
+ 				color: (Color 
+ 							r: 0.8
+ 							g: 0.8
+ 							b: 0.8).
+ 	frame := (AlignmentMorph new)
+ 				color: Color transparent;
+ 				listDirection: #leftToRight;
+ 				hResizing: #spaceFill;
+ 				vResizing: #shrinkWrap;
+ 				layoutInset: 0.
+ 	frame
+ 		addMorph: (button
+ 					label: '>>';
+ 					actionSelector: #nextYear;
+ 					width: 15);
+ 		addMorph: ((button copy)
+ 					label: '>';
+ 					actionSelector: #next;
+ 					width: 15);
+ 		addMorph: (((AlignmentMorph new)
+ 					color: Color transparent;
+ 					listDirection: #topToBottom;
+ 					wrapCentering: #center;
+ 					cellPositioning: #topCenter;
+ 					extent: (title fullBounds width - (button width * 3)) @ title height) 
+ 						addMorph: (StringMorph new 
+ 								contents: monthName , ' ' , month year printString));
+ 		addMorph: ((button copy)
+ 					label: '<';
+ 					actionSelector: #previous;
+ 					width: 15);
+ 		addMorph: ((button copy)
+ 					label: '<<';
+ 					actionSelector: #previousYear;
+ 					width: 15).
+ 	"hResizing: #shrinkWrap;"
+ 	self addMorph: frame!

Item was added:
+ ----- Method: MonthMorph>>initializeWeeks (in category 'initialization') -----
+ initializeWeeks
+ 	| weeks |
+ 	self removeAllMorphs.
+ 	weeks _ OrderedCollection new.
+ 	month weeksDo:
+ 		[ :w |
+ 		weeks add: (WeekMorph newWeek: w month: month tileRect: tileRect model: model)].
+ 
+ 	weeks reverseDo: 
+ 		[ :w | 
+ 		w hResizing: #spaceFill; vResizing: #spaceFill.
+ 		"should be done by WeekMorph but isn't"
+ 		w submorphsDo:[ :m | m hResizing: #spaceFill; vResizing: #spaceFill ].
+ 		self addMorph: w ].
+ 
+ 	self 
+ 		initializeHeader;
+ 		highlightToday.
+ 
+ !

Item was added:
+ ----- Method: MonthMorph>>model: (in category 'initialization') -----
+ model: aModel
+ 
+ 	model _ aModel!

Item was added:
+ ----- Method: MonthMorph>>month (in category 'access') -----
+ month
+ 	^ month!

Item was added:
+ ----- Method: MonthMorph>>month: (in category 'controls') -----
+ month: aMonth
+ 	month _ aMonth.
+ 	model ifNotNil: [model setDate: nil fromButton: nil down: false].
+ 	self initializeWeeks!

Item was added:
+ ----- Method: MonthMorph>>next (in category 'controls') -----
+ next
+ 	self month: month next!

Item was added:
+ ----- Method: MonthMorph>>nextYear (in category 'controls') -----
+ nextYear
+ 	self month: (Month month: month month year: month year + 1)
+ !

Item was added:
+ ----- Method: MonthMorph>>previous (in category 'controls') -----
+ previous
+ 	self month: month previous!

Item was added:
+ ----- Method: MonthMorph>>previousYear (in category 'controls') -----
+ previousYear
+ 	self month: (Month month: month month year: month year - 1)
+ !

Item was added:
+ ----- Method: MonthMorph>>selectedDates (in category 'access') -----
+ selectedDates
+ 	| answer |
+ 	answer _ SortedCollection new.
+ 	self submorphsDo:
+ 		[:each |
+ 		(each isKindOf: WeekMorph) ifTrue: [answer addAll: each selectedDates]].
+ 	^ answer !

Item was added:
+ ----- Method: MonthMorph>>startMondayOrSundayString (in category 'controls') -----
+ startMondayOrSundayString
+ 	^(Week startDay  ifTrue: ['start Sunday'] ifFalse: ['start Monday']) 
+ 		translated!

Item was added:
+ ----- Method: MonthMorph>>step (in category 'stepping and presenter') -----
+ step
+ 
+ 	todayCache = Date today
+ 		ifFalse: [self highlightToday  "Only happens once a day"]!

Item was added:
+ ----- Method: MonthMorph>>stepTime (in category 'testing') -----
+ stepTime
+ 	"Only time stepping matters is when you start up an image where an old date is selected"
+ 
+ 	^ 3000  "Three seconds should be good enough response"!

Item was added:
+ ----- Method: MonthMorph>>toggleStartMonday (in category 'controls') -----
+ toggleStartMonday
+ 
+ 	(Week startDay = #Monday)
+ 		ifTrue: [ Week startDay: #Sunday ]
+ 		ifFalse: [ Week startDay: #Monday ].
+ 
+ 	self initializeWeeks
+ !

Item was added:
+ ----- Method: Morph class>>additionsToViewerCategoryAsObject (in category '*Etoys-Squeakland-scripting') -----
+ additionsToViewerCategoryAsObject
+ 	"Answer viewer additions for the 'as object' category.  Just priming the pump at this point."
+ 
+ 	^#(
+ 		#'as object' 
+ 		(
+ 			(slot size 'My physical size' Number readOnly Player getObjectSize unused unused)
+ 			(slot name  	'The name by which I am known' String readWrite Player 	getName Player setName:)
+ 			(slot hash 'My hash value' Number readOnly Player getHash unused unused)
+ 			(command explore 'Open up an Explorer on this object')
+ 			(command halt: 'Put up a pre-debug notifier' String)
+ 			(slot printString 'A string rendition of myself' String readOnly  Player getPrintString unused unused)
+ 			(command inform: 'Put up message box for the user' String)
+ 			(command printInTranscript 'Prints a description of the object to the Transcript')
+ 			(command printDirectlyToDisplay 'Prints a description of the object directly to the screen')
+ 			(slot className 'The name of the class of the object' String readOnly player getClassName unused unused)
+ 
+ 		))
+ !

Item was changed:
  ----- Method: Morph class>>additionsToViewerCategoryConnection (in category '*eToys-scripting') -----
  additionsToViewerCategoryConnection
  	"Answer viewer additions for the 'connection' category"
  	"Vocabulary initialize"
  
  	^{
  		#'connections to me'.
  		#(
  		(command tellAllPredecessors: 'Send a message to all graph predecessors' ScriptName)
+ 		(command tellAllSuccessors: 'Send a message to all graph successors' ScriptName)
- 		(command tellAllSuccessors: 'Send a message to all graph predecessors' ScriptName)
  		(command tellAllIncomingConnections: 'Send a message to all the connectors whose destination end is connected to me' ScriptName)
  		(command tellAllOutgoingConnections: 'Send a message to all the connectors whose source end is connected to me' ScriptName)
  		(slot incomingConnectionCount 'The number of connectors whose destination end is connected to me' Number readOnly Player getIncomingConnectionCount unused unused)
  		(slot outgoingConnectionCount 'The number of connectors whose source end is connected to me' Number readOnly Player getOutgoingConnectionCount unused unused)
  		)
  	}
  !

Item was added:
+ ----- Method: Morph class>>additionsToViewerCategoryFillAndBorder (in category '*Etoys-Squeakland-scripting') -----
+ additionsToViewerCategoryFillAndBorder
+ 	"Answer viewer additions for the 'color & border' category"
+ 
+ 	^#(
+ 		#'fill & border' 
+ 		(
+ 			(slot color 'The color of the object' Color readWrite Player getColor  Player  setColor:)
+ 			(slot borderStyle 'The style of the object''s border' BorderStyle readWrite Player getBorderStyle player setBorderStyle:)
+ 			(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 roundedCorners 'Whether corners should be rounded' Boolean readWrite Player getRoundedCorners Player setRoundedCorners:)
+ 
+ 			(slot gradientFill 'Whether a gradient fill should be used' Boolean readWrite Player getUseGradientFill Player setUseGradientFill:)
+ 			(slot secondColor 'The second color used when gradientFill is in effect' Color readWrite Player getSecondColor Player setSecondColor:)
+ 
+ 			(slot radialFill 'Whether the gradient fill, if used, should be radial' Boolean readWrite Player getRadialGradientFill Player setRadialGradientFill:)
+ 
+ 			(slot dropShadow 'Whether a drop shadow is shown' Boolean readWrite Player getDropShadow Player setDropShadow:)
+ 			(slot shadowColor 'The color of the drop shadow' Color readWrite Player getShadowColor Player setShadowColor:)
+ 		)
+ 	)
+ !

Item was changed:
  ----- Method: Morph class>>additionsToViewerCategoryGeometry (in category '*eToys-scripting') -----
  additionsToViewerCategoryGeometry
  	"answer additions to the geometry viewer category"
  
  	^ #(geometry 
  		(
  			(slot x   'The x coordinate' Number readWrite Player  getX   Player setX:)
  			(slot y   'The y coordinate' Number readWrite Player  getY  Player setY:)
+ 
  			(slot heading  'Which direction the object is facing.  0 is straight up' Number readWrite Player getHeading  Player setHeading:)
  
  			(slot  scaleFactor 'The factor by which the object is magnified' Number readWrite Player getScaleFactor Player setScaleFactor:)
  			(slot  left   'The left edge' Number readWrite Player getLeft  Player  setLeft:)
  			(slot  right  'The right edge' Number readWrite Player getRight  Player  setRight:)
  			(slot  top  'The top edge' Number readWrite Player getTop  Player  setTop:) 
  			(slot  bottom  'The bottom edge' Number readWrite Player getBottom  Player  setBottom:) 
- 			(slot  length  'The length' Number readWrite Player getLength  Player  setLength:) 
- 			(slot  width  'The width' Number readWrite Player getWidth  Player  setWidth:)
  
+ 			(slot forwardDirection 'The angle of my forward direction without rotating myself' Number readWrite Player getForwardDirection Player setForwardDirection: )
- 			(slot headingTheta 'The angle, in degrees, that my heading vector makes with the positive x-axis' Number readWrite Player getHeadingTheta Player setHeadingTheta:)
- 
- 			(slot distance 'The length of the vector connecting the origin to the object''s position' Number readWrite Player getDistance Player setDistance:)
- 			(slot theta 'The angle between the positive x-axis and the vector connecting the origin to the object''s position' Number readWrite Player getTheta Player setTheta: )
  		)
  	)
  
  
  !

Item was added:
+ ----- Method: Morph class>>additionsToViewerCategoryGraphing (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ additionsToViewerCategoryGraphing
+ 	"answer additions to the graphing viewer category"
+ 
+ 	^ #(graphing 
+ 		(
+ 			(slot xOnGraph   'If there is a horizontal axis present, gives the horizontal coordinate of the center of this object with respect to that axis ' Number readWrite Player  getXOnGraph   Player setXOnGraph:)
+ 			(slot yOnGraph   'If there is a vertical axis present, gives the vertical coordinate of the center of this object with respect to that axis ' Number readWrite Player  getYOnGraph   Player setYOnGraph:)
+ 			(slot locationOnGraph   'If there is are axes present, gives the coordinate of the center of this object with respect to those axes ' Point readWrite Player  getLocationOnGraph   Player setLocationOnGraph:)))!

Item was added:
+ ----- Method: Morph class>>additionsToViewerCategoryInput (in category '*Etoys-Squeakland-scripting') -----
+ additionsToViewerCategoryInput
+ 	"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."
+ 
+ 	^ #(input (
+ 			(slot lastKeystroke 'The last unhandled keystroke' String readWrite Player getLastKeystroke Player setLastKeystroke:)
+ 	))!

Item was changed:
  ----- Method: Morph class>>additionsToViewerCategoryMiscellaneous (in category '*eToys-scripting') -----
  additionsToViewerCategoryMiscellaneous
  	"Answer viewer additions for the 'miscellaneous' category"
  
  	^#(
  		miscellaneous 
  		(
  			(command doMenuItem: 'do the menu item' Menu)
  			(command show 'make the object visible')
  			(command hide 'make the object invisible')
+ 		"	(command wearCostumeOf: 'wear the costume of...' Player)"
- 			(command wearCostumeOf: 'wear the costume of...' Player)
  
  			(command fire 'trigger any and all of this object''s button actions')
  			(slot copy 'returns a copy of this object' Player readOnly Player getNewClone	 unused unused)
  			(slot elementNumber 'my index in my container' Number readWrite Player getIndexInOwner Player setIndexInOwner:)
  			(slot holder 'the object''s container' Player readOnly Player getHolder Player setHolder:)
  			(command stamp 'add my image to the pen trails')
  			(command erase 'remove this object from the screen')
  			(command stampAndErase 'add my image to the pen trails and go away')
  		)
  	)
  
  !

Item was added:
+ ----- Method: Morph class>>additionsToViewerCategoryMoreGeometry (in category '*Etoys-Squeakland-scripting') -----
+ additionsToViewerCategoryMoreGeometry
+ 	"answer additions to the more geometry viewer category"
+ 
+ 	^ #(#'more geometry' 
+ 		(
+ 			(slot location 'The position of the object, expressed as a point' Point readWrite Player getLocationRounded Player setLocation:)
+ 
+ 			(slot  length  'The length' Number readWrite Player getLength  Player  setLength:) 
+ 			(slot  width  'The width' Number readWrite Player getWidth  Player  setWidth:)
+ 
+ 			(slot headingTheta 'The angle, in degrees, that my heading vector makes with the positive x-axis' Number readWrite Player getHeadingTheta Player setHeadingTheta:)
+ 
+ 			(slot distance 'The length of the vector connecting the origin to the object''s position' Number readWrite Player getDistance Player setDistance:)
+ 
+ 			(slot theta 'The angle between the positive x-axis and the vector connecting the origin to the object''s position' Number readWrite Player getTheta Player setTheta: )
+ 			(slot rotationCenterX 'The x coordinate of rotation center in parent''s coordinate system.' Number readWrite Player getRotationCenterX Player setRotationCenterX: )
+ 			(slot rotationCenterY 'The y coordinate of rotation center in parent''s coordinate system.' Number readWrite Player getRotationCenterY Player setRotationCenterY: )
+ 
+ 			"(command forceAxisToX: 'Force change x of axis for rotation' Number )
+ 			(command forceAxisToY: 'Force change y of axis for rotation' Number )"
+ 
+ 		)
+ 	)
+ 
+ 
+ !

Item was changed:
  ----- Method: Morph class>>additionsToViewerCategoryMotion (in category '*eToys-scripting') -----
  additionsToViewerCategoryMotion
  	"Answer viewer additions for the 'motion' category"
  
  	^#(
  		motion 
  		(
  			(slot x 'The x coordinate' Number readWrite Player getX Player setX:)
  			(slot y  	'The y coordinate' Number readWrite Player 	getY Player setY:)
  			(slot heading  'Which direction the object is facing.  0 is straight up' Number readWrite Player getHeading Player setHeading:)
  			(command forward: 'Moves the object forward in the direction it is heading' Number)
  			(slot obtrudes 'whether the object sticks out over its container''s edge' Boolean readOnly Player getObtrudes unused unused) 
  			(command turnToward: 'turn toward the given object' Player) 
+ 			(command moveToward: 'Move toward the given object. If the object has an instance variable named speed, the speed of the motion will be governed by that value' Player) 
- 			(command moveToward: 'move toward the given object' Player) 
  			(command turn: 'Change the heading of the object by the specified amount' Number)
  			(command bounce: 'bounce off the edge if hit' Sound) 
  			(command wrap 'wrap off the edge if appropriate') 
  			(command followPath 'follow the yellow brick road') 
  			(command goToRightOf: 'place this object to the right of another' Player)
  		)
  	)
  
  !

Item was changed:
  ----- Method: Morph class>>additionsToViewerCategoryObservation (in category '*eToys-scripting') -----
  additionsToViewerCategoryObservation
  	"Answer viewer additions for the 'observations' category"
  
  	^#(
  		observation
   
  		(
  			(slot colorUnder 'The color under the center of the object' Color readOnly Player getColorUnder unused  unused )
  			(slot brightnessUnder 'The brightness under the center of the object' Number readOnly Player getBrightnessUnder unused unused)
  			(slot luminanceUnder 'The luminance under the center of the object' Number readOnly Player getLuminanceUnder unused unused)
  			(slot saturationUnder 'The saturation under the center of the object' Number readOnly Player getSaturationUnder unused unused)
+ 		(slot distanceToPlayer 'The distance to another object' Number readOnly Player distanceToPlayer: unused unused)
+ 		(slot bearingTo 'The heading I would need to have to face directly toward another object' Number readOnly Player bearingTo: unused unused)
+ 	"	(slot bearingFrom 'The heading another object would need to have in order to face directly toward me' Number readOnly Player bearingFrom: unused unused)"
  		
  		))
  !

Item was added:
+ ----- Method: Morph class>>additionsToViewerCategorySpeechBubbles (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ additionsToViewerCategorySpeechBubbles
+ 	^#(
+ 		#'speech bubbles' 
+ 		(
+ 			(command sayText: 'Show a text in a speech bubble' String)
+ 			(command thinkText: 'Show a text in a thought bubble' String)
+ 			(command sayNumber: 'Show a number in a speech bubble' Number)
+ 			(command thinkNumber: 'Show a number in a thought bubble' Number)
+ 			(command sayGraphic: 'Show a picture in a speech bubble' Graphic)
+ 			(command thinkGraphic: 'Show a picture in a thought bubble' Graphic)
+ 			(command sayObject: 'Show an object in a speech bubble' Player)
+ 			(command thinkObject: 'Show an object in a thought bubble' Player)
+ 			(command stopSayingOrThinking 'Erase all speech bubbles attached to this object, if any')
+ 			(slot bubble 'The bubble currently attached to this object' Player readOnly Player getBubble Player unused)		
+ 		))!

Item was added:
+ ----- Method: Morph class>>additionsToViewerCategoryWorldGeometry (in category '*Etoys-Squeakland-eToys-scripting') -----
+ additionsToViewerCategoryWorldGeometry
+ 	"answer additions to the geometry viewer category"
+ 
+ 	^ #( #'world geometry' 
+ 		(
+ 			(slot  length  'The length' Number readWrite Player getLength  Player  setLength:  ) 
+ 			(slot  width  'The width' Number readWrite Player getWidth  Player  setWidth:  )
+ 			(slot  left   'The left edge' Number readWrite Player getLeft  Player  setLeft:  )
+ 			(slot  right  'The right edge' Number readWrite Player getRight  Player  setRight:  )
+ 			(slot  top  'The top edge' Number readWrite Player getTop  Player  setTop:   ) 
+ 			(slot  bottom  'The bottom edge' Number readWrite Player getBottom  Player  setBottom:  ) 
+ 
+ 			
+ 		)
+ 	)
+ 
+ 
+ !

Item was added:
+ ----- Method: Morph class>>fromStreamedRepresentation: (in category '*Etoys-Squeakland-fileIn/Out') -----
+ fromStreamedRepresentation: aString
+ 	^SmartRefStream objectFromStreamedRepresentation: aString!

Item was changed:
  ----- Method: Morph class>>helpContributions (in category '*eToys-scripting') -----
  helpContributions
  	"Answer a list of pairs of the form (<symbol> <help message> ) to contribute to the system help dictionary"
  	
  "NB: Many of the items here are not needed any more since they're specified as part of command definitions now.  Someone needs to take the time to go through the list and remove items no longer needed.  But who's got that kind of time?"
  
  	^ #(
  		(acceptScript:for:
  			'submit the contents of the given script editor as the code defining the given selector')
  		(actorState
  			'return the ActorState object for the receiver, creating it if necessary')
  		(addInstanceVariable
  			'start the interaction for adding a new variable to the object')
  		(addPlayerMenuItemsTo:hand:
  			'add player-specific menu items to the given menu, on behalf of the given hand.  At present, these are only commands relating to the turtle')
  		(addYesNoToHand
+ 			'Press here to tear off a TEST/YES/NO unit which you can drop into your script')
- 			'Press here to tear off a  TEST/YES/NO unit which you can drop into your script')
  		(allScriptEditors
  			'answer a list off the extant ScriptEditors for the receiver')
  		(amount
  			'The amount of displacement')
  		(angle	
  			'The angular displacement')
  		(anonymousScriptEditorFor:
  			'answer a new ScriptEditor object to serve as the place for scripting an anonymous (unnamed, unsaved) script for the receiver')
  		(append:
  			'add an object to this container')
  		(prepend:
  			'add an object to this container')
  		(assignDecrGetter:setter:amt:
  			'evaluate the decrement variant of assignment')
  		(assignGetter:setter:amt:
  			'evaluate the vanilla variant of assignment')
  		(assignIncrGetter:setter:amt:
  			'evalute the increment version of assignment')
  		(assignMultGetter:setter:amt:
  			'evaluate the multiplicative version of assignment')
  		(assureEventHandlerRepresentsStatus
  			'make certain that the event handler associated with my current costume is set up to conform to my current script-status')
  		(assureExternalName
  			'If I do not currently have an external name assigned, get one now')
  		(assureUniClass
  			'make certain that I am a member a uniclass (i.e. a unique subclass); if I am not, create one now and become me into an instance of it')
  		(availableCostumeNames
  			'answer a list of strings representing the names of all costumes currently available for me')
  		(availableCostumesForArrows
  			'answer a list of actual, instantiated costumes for me, which can be cycled through as the user hits a next-costume or previous-costume button in a viewer')
  		(beep:
  			'make the specified sound')
  		(borderColor
  			'The color of the object''s border')
  		(borderWidth
  			'The width of the object''s border')
  		(bottom
  			'My bottom edge, measured downward from the top edge of the world')
  		(bounce:
  			'If object strayed beyond the boundaries of its container, make it reflect back into it, making the specified noise while doing so.')
  		(bounce
  			'If object strayed beyond the boundaries of its container, make it reflect back into it')
  		(chooseTrigger
  'When this script should run.
  "normal" means "only when called"')
  		(clearTurtleTrails
  			'Clear all the pen trails in the interior.')
  		(clearOwnersPenTrails
  			'Clear all the pen trails in my container.')
  		(color	
  			'The object''s interior color')
  		(colorSees
  			'Whether a given color in the object is over another given color')
  		(colorUnder
  			'The color under the center of the object')
  		(copy
  			'Return a new object that is very much like this one')
  		(cursor	
  			'The index of the chosen element')
  		(deleteCard
  			'Delete the current card.')
  		(dismiss
  			'Click here to dismiss me')
  		(doMenuItem:
  			'Do a menu item, the same way as if it were chosen manually')
  		(doScript:
  			'Perform the given script once, on the next tick.')
  		(elementNumber
  			'My element number as seen by my owner')
  		(fire
  			'Run any and all button-firing scripts of this object')
  		(firstPage
  			'Go to first page of book')
  		(followPath
  				'Retrace the path the object has memorized, if any.')
  		(forward:
  			'Moves the object forward in the direction it is heading') 
  		(goto:
  			'Go to the specfied book page')
  		(goToNextCardInStack
  			'Go to the next card')
  		(goToPreviousCardInStack
  			'Go to the previous card.')
  		(goToRightOf:
  			'Align the object just to the right of any specified object.')
  		(heading
  			'Which direction the object is facing.  0 is straight up') 
  		(height	
  			'The distance between the top and bottom edges of the object')
  		(hide
  			'Make the object so that it does not display and cannot handle input')
  		(initiatePainting	
  			'Initiate painting of a new object in the standard playfield.')
  		(initiatePaintingIn:
  			'Initiate painting of a new object in the given place.')
  		(isOverColor
  			'Whether any part of this object is directly over the specified color')
  		(isUnderMouse
  			'Whether any part of this object is beneath the current mouse-cursor position')
  		(lastPage
  			'Go to the last page of the book.')
  		(left
  			'My left edge, measured from the left edge of the World')
  		(leftRight
  			'The horizontal displacement')
  		(liftAllPens
  			'Lift the pens on all the objects in my interior.')
  		(lowerAllPens
  			'Lower the pens on all the objects in my interior.')
  		(mouseX
  			'The x coordinate of the mouse pointer')
  		(mouseY
  			'The y coordinate of the mouse pointer')
  		(moveToward:
  			'Move in the direction of another object.')
  		(insertCard
  			'Create a new card.')
  		(nextPage
  			'Go to next page.')
  		(numberAtCursor
  			'The number held by the object at the chosen element')
  		(objectNameInHalo
  			'Object''s name -- To change: click here, edit, hit ENTER')
  		(obtrudes
  			'Whether any part of the object sticks out beyond its container''s borders')
  		(offerScriptorMenu
  			'The Scriptee.
  Press here to get a menu')
  		(pauseScript:
  			'Make a running script become paused.')
  		(penDown
  			'Whether the object''s pen is down (true) or up (false)')
  		(penColor
  			'The color of the object''s pen')
  		(penSize	
  			'The size of the object''s pen')
  		(clearPenTrails
  			'Clear all pen trails in the current playfield')
  		(playerSeeingColorPhrase
  			'The player who "sees" a given color')
  		(previousPage
  			'Go to previous page')
  
  		(show
  			'If object was hidden, make it show itself again.')
  		(startScript:
  			'Make a script start running.')
  		(stopScript:
  			'Make a script stop running.')
  		(top
  			'My top edge, measured downward from the top edge of the world')
  		(right
  			'My right edge, measured from the left edge of the world')
  		(roundUpStrays
  			'Bring all out-of-container subparts back into view.')
  		(scaleFactor
  			'The amount by which the object is scaled')
+ 		(stepMe
+ 			'Run the next phrase in the script.')
  		(stopScript:
  			'make the specified script stop running')
  		(tellAllSiblings:
  			'send a message to all of my sibling instances')
  		(try
+ 			'Run this command once.' translatedNoop)
- 			'Run this command once.')
  		(tryMe
+ 			'Click here to run this script once; hold button down to run repeatedly'  translatedNoop)
- 			'Click here to run this script once; hold button down to run repeatedly')
  		(turn:				
  			'Change the heading of the object by the specified amount')
  		(unhideHiddenObjects
  			'Unhide all hidden objects.')
  		(upDown
  			'The vertical displacement')
  		(userScript
  			'This is a script defined by you.')
  		(userSlot
  			'This is a variable defined by you.  Click here to change its type')
  		(valueAtCursor
  			'The chosen element')
  		(wearCostumeOf:
+ 			'Make this object''s appearance be the same as that of another object')
- 			'Wear the same kind of costume as the other object')
  		(width	
  			'The distance between the left and right edges of the object')
  		(wrap
  			'If object has strayed beond the boundaries of its container, make it reappear from the opposite edge.')
  		(x
  			'The x coordinate, measured from the left of the container')
  		(y
  			'The y-coordinate, measured upward from the bottom of the container')
  
  		)
  !

Item was added:
+ ----- Method: Morph class>>inARow: (in category '*Etoys-Squeakland-instance creation') -----
+ inARow: aCollectionOfMorphs
+ 	"Answer an instance of the receiver, a row morph, with the given collection as its submorphs, and transparent in color.  Interpret the symbol #spacer in the incoming list as a request for a variable transparent spacer."
+ 
+ 	| row |
+ 	row _ self new.
+ 	row layoutPolicy: TableLayout new.
+ 	row
+ 		listDirection: #leftToRight;
+ 		vResizing: #shrinkWrap;
+ 		hResizing: #spaceFill;
+ 		layoutInset: 0;
+ 		cellPositioning: #center;
+ 		borderWidth: 0;
+ 		color: Color transparent.
+ 	aCollectionOfMorphs do:
+ 		[ :each |  | toAdd |
+ 			toAdd := each == #spacer
+ 				ifTrue:
+ 					[AlignmentMorph newVariableTransparentSpacer]
+ 				ifFalse:
+ 					[each].
+ 			row addMorphBack: toAdd].
+ 	^ row
+ !

Item was added:
+ ----- Method: Morph class>>newInHand (in category '*Etoys-Squeakland-instance creation') -----
+ newInHand
+ 	"Hand the user a freshly-minted new instance of the receiver."
+ 
+ 	^ self new openInHand !

Item was added:
+ ----- Method: Morph class>>openInWorldOrWorldlet (in category '*Etoys-Squeakland-instance creation') -----
+ openInWorldOrWorldlet
+ 	"Open in the world-like creature affiliated with the active Hand."
+ 
+ 	^ self new openInWorldOrWorldlet!

Item was added:
+ ----- Method: Morph class>>partsDescriptionsFromToolsFlap (in category '*Etoys-Squeakland-parts bin') -----
+ partsDescriptionsFromToolsFlap
+ 	"Answer a list of DescriptionForPartsBin objects that characterize objects normally found in the Tools flap that should be shown in the Objects catalog."
+ 
+ 	^ Flaps quadsDefiningToolsFlap asArray select: [:q | (#(Preferences Workspace TranscriptSream) includes: q first) and: [q second ~~ #annotationEditingWindow]] thenCollect: 
+ 		[:r | DescriptionForPartsBin fromQuad: r categoryList: #()]
+ 
+ "
+ Morph partsDescriptionsFromToolsFlap
+ "!

Item was added:
+ ----- Method: Morph>>aboutToBeBrownDragged (in category '*Etoys-Squeakland-halo notification') -----
+ aboutToBeBrownDragged
+ 	"The receiver is about to be brown-dragged (constrained within container) by the halo."!

Item was added:
+ ----- Method: Morph>>aboutToBeGrownViaHalo (in category '*Etoys-Squeakland-halo notification') -----
+ aboutToBeGrownViaHalo
+ 	"The receiver is about to be grown via the halo."!

Item was added:
+ ----- Method: Morph>>aboutToBeRotatedViaHalo (in category '*Etoys-Squeakland-halo notification') -----
+ aboutToBeRotatedViaHalo
+ 	"The receiver is about to be rotated via the halo."!

Item was added:
+ ----- Method: Morph>>aboutToBeScaledViaHalo (in category '*Etoys-Squeakland-halo notification') -----
+ aboutToBeScaledViaHalo
+ 	"The receiver is about to be scaled via the halo."!

Item was added:
+ ----- Method: Morph>>addLockingItemsTo: (in category '*Etoys-Squeakland-menu & halo') -----
+ addLockingItemsTo: aMenu
+ 	"Add locking-related items to the given menu.  If any items are needed, a line will be added before them, and it is incumbent on the sender to add a line after them, if required."
+ 
+ 	| unlockables |
+ 	unlockables _ self submorphs select:
+ 		[:m | m isLocked].
+ 	unlockables size = 0 ifTrue: [^  self].
+ 
+ 	aMenu addLine.
+ 	unlockables size == 1 ifTrue:
+ 		[aMenu add: ('unlock "{1}"' translated format:{unlockables first externalName})action: #unlockContents].
+ 	unlockables size > 1 ifTrue:
+ 		[aMenu add: 'unlock all contents' translated action: #unlockContents.
+ 		aMenu add: 'unlock...' translated action: #unlockOneSubpart].!

Item was added:
+ ----- Method: Morph>>addMorphInLayer:centeredNear: (in category '*Etoys-Squeakland-WiW support') -----
+ addMorphInLayer: aMorph centeredNear: aPoint
+ 	"Add the given morph to this world, attempting to keep its center as close to the given point possible while also keeping the it entirely within the bounds of this world."
+ 
+ 	| trialRect delta |
+ 	trialRect _ Rectangle center: aPoint extent: aMorph fullBounds extent.
+ 	delta _ trialRect amountToTranslateWithin: bounds.
+ 	aMorph position: trialRect origin + delta.
+ 	self addMorphInLayer: aMorph.
+ !

Item was changed:
  ----- Method: Morph>>addPlayerItemsTo: (in category '*Etoys') -----
  addPlayerItemsTo: aMenu
  	"Add player-related items to the menu if appropriate"
  
  	| aPlayer subMenu |
  	self couldMakeSibling ifFalse: [^ self].
+ 	aPlayer _ self topRendererOrSelf player.
+ 	subMenu _ MenuMorph new defaultTarget: self.
- 	aPlayer := self topRendererOrSelf player.
- 	subMenu := MenuMorph new defaultTarget: self.
  	subMenu add: 'make a sibling instance' translated target: self action: #makeNewPlayerInstance:.
  	subMenu balloonTextForLastItem: 'Makes another morph whose player is of the same class as this one.  Both siblings will share the same scripts' translated.
  
  	subMenu add: 'make multiple siblings...' translated target: self action: #makeMultipleSiblings:.
  	subMenu balloonTextForLastItem: 'Make any number of sibling instances all at once' translated.
  
  	(aPlayer belongsToUniClass and: [aPlayer class instanceCount > 1]) ifTrue:
  		[subMenu addLine.
+ 		self renderedMorph isSketchMorph ifTrue:
+ 			[subMenu add: 'make all siblings look like me' translated target: self action: #makeSiblingsLookLikeMe:.
+ 			subMenu balloonTextForLastItem: 'make all my sibling instances look like me.' translated].
- 		subMenu add: 'make all siblings look like me' translated target: self action: #makeSiblingsLookLikeMe:.
- 		subMenu balloonTextForLastItem: 'make all my sibling instances look like me.' translated.
  
  		subMenu add: 'bring all siblings to my location' translated target: self action: #bringAllSiblingsToMe:.
  		subMenu balloonTextForLastItem: 'find all sibling instances and bring them to me' translated.
  
  		subMenu add: 'apply status to all siblngs' translated target: self action: #applyStatusToAllSiblings:.
  		subMenu balloonTextForLastItem: 'apply the current status of all of my scripts to the scripts of all my siblings' translated].
  
  		subMenu add: 'indicate all siblings' translated target: self action: #indicateAllSiblings.
+ 		subMenu balloonTextForLastItem: 'momentarily show, by flashing , all of my visible siblings.' translated.
- 		subMenu balloonTextForLastItem: 'momentarily show, by flashing , all of my visible siblings.'.
  
  		aMenu add: 'siblings...' translated subMenu: subMenu
  
  !

Item was changed:
  ----- Method: Morph>>addTransparentSpacerOfSize: (in category '*Etoys-geometry') -----
  addTransparentSpacerOfSize: aPoint
+ 	self addMorphBack: (self transparentSpacerOfSize: aPoint asPoint)!
- 	self addMorphBack: (self transparentSpacerOfSize: aPoint)!

Item was added:
+ ----- Method: Morph>>boundsInStagingArea (in category '*Etoys-Squeakland-geometry') -----
+ boundsInStagingArea
+ 	"Answer the receiver's bounds with reference to a putative staging area."
+ 
+ 	^ self bounds: self bounds in: self stagingArea!

Item was added:
+ ----- Method: Morph>>brownDragConcluded (in category '*Etoys-Squeakland-halo notification') -----
+ brownDragConcluded
+ 	"After the user has manually repositioned the receiver via brown-halo-drag"
+ !

Item was added:
+ ----- Method: Morph>>bubble (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ bubble
+ 	^self valueOfProperty: #bubble ifAbsent: [nil].!

Item was added:
+ ----- Method: Morph>>bubble: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ bubble: aSpeechBubbleMorph
+ self setProperty: #bubble toValue: aSpeechBubbleMorph !

Item was added:
+ ----- Method: Morph>>changeColorSimply (in category '*Etoys-Squeakland-meta-actions') -----
+ changeColorSimply
+ 	"Put up the simplest color picker to change the receiver's color."
+ 
+ 	((self renderedMorph fillStyle isKindOf: InfiniteForm) and:
+ 			[self renderedMorph hasProperty: #graphPaperParameters])
+ 		ifTrue:
+ 			[self changeGraphPaper]
+ 		ifFalse:
+ 			[self changeColor]!

Item was added:
+ ----- Method: Morph>>changeColorTarget:selector:originalColor:hand:showPalette: (in category '*Etoys-Squeakland-meta-actions') -----
+ changeColorTarget: anObject selector: aSymbol originalColor: aColor hand: aHand showPalette: showPalette
+ 	"Put up a color picker for changing some kind of color.  May be modal or modeless, depending on #modalColorPickers setting"
+ 	| c aRectangle |
+ 	self flag: #arNote. "Simplify this due to anObject == self for almost all cases"
+ 	c _ ColorPickerMorph new.
+ 	c
+ 		choseModalityFromPreference;
+ 		sourceHand: aHand;
+ 		target: anObject;
+ 		selector: aSymbol;
+ 		originalColor: aColor.
+ 		showPalette ifFalse: [c initializeForJustCursor].
+ 		aRectangle := (anObject == ActiveWorld)
+ 			ifTrue:
+ 				[ActiveHand position extent: (20 at 20)]
+ 			ifFalse:
+ 				[anObject isMorph
+ 					ifFalse:
+ 						[Rectangle center: self position extent: (20 at 20)]
+ 					ifTrue:
+ 						 [anObject fullBoundsInWorld]].
+ 
+ 		c putUpFor: anObject near: aRectangle!

Item was added:
+ ----- Method: Morph>>changeGraphPaper (in category '*Etoys-Squeakland-visual properties') -----
+ changeGraphPaper
+ 	"Make receiver use a graph-paper fill"
+ 
+ 	"At present does not actually establish graph paper unless/until the user hits Accept in the graph-paper dialog."
+ 
+ 	self makeGraphPaper!

Item was added:
+ ----- Method: Morph>>chosenColor: (in category '*Etoys-Squeakland-e-toy support') -----
+ chosenColor: aColor
+ 	"Temporarily remember a color in a property named chosenColor"
+ 
+ 	self setProperty: #chosenColor toValue: aColor!

Item was added:
+ ----- Method: Morph>>collapsible (in category '*Etoys-Squeakland-geometry') -----
+ collapsible
+ 	"Answer whether the receiver is currently a candidate for collapsing."
+ 
+ 	^ self wantsToBeTopmost not!

Item was added:
+ ----- Method: Morph>>convertExtension (in category '*Etoys-Squeakland-accessing - extension') -----
+ convertExtension
+ 	"Convert old extensions to MorphExtensionPlus"
+ 
+ 	| newExtension newOther |
+ 	(self hasExtension and: [extension isMemberOf: MorphExtension]) ifTrue: [
+ 		newExtension := extension as: MorphExtensionPlus.
+ 		extension otherProperties ifNotNil: [
+ 			newOther := IdentityDictionary new.
+ 			extension otherProperties associationsDo: [:assoc |
+ 				(#(layoutProperties layoutPolicy decimalPlaces) includes: assoc key) ifTrue: [
+ 					((self isKindOf: UpdatingStringMorph)
+ 						and: [UpdatingStringMorph instVarNames includes: assoc key asString]) ifTrue: [
+ 							self instVarNamed: assoc key asString put: assoc value
+ 						] ifFalse: [
+ 							(MorphExtensionPlus instVarNames includes: assoc key asString) ifTrue: [
+ 								newExtension instVarNamed: assoc key asString put: assoc value
+ 							] ifFalse: [
+ 								newOther add: assoc
+ 							].
+ 						]
+ 				] ifFalse: [newOther add: assoc].
+ 			].
+ 			newOther isEmpty ifTrue: [newOther := nil].
+ 			newExtension otherProperties: newOther
+ 		].
+ 		extension := newExtension
+ 	]
+ !

Item was added:
+ ----- Method: Morph>>convertNovember2000DropShadow:using: (in category '*Etoys-Squeakland-object fileIn') -----
+ convertNovember2000DropShadow: varDict using: smartRefStrm 
+ 	"Work hard to eliminate the DropShadow. Inst vars are already  
+ 	stored into."
+ 
+ 	| rend |
+ 	submorphs notEmpty 
+ 		ifTrue: 
+ 			[rend := submorphs first renderedMorph.
+ 			"a text?"
+ 			rend setProperty: #hasDropShadow toValue: true.
+ 			rend setProperty: #shadowColor toValue: (varDict at: 'color').
+ 			rend setProperty: #shadowOffset toValue: (varDict at: 'shadowOffset').
+ 			"ds owner ifNotNil: [ds owner addAllMorphs: ds  
+ 			submorphs]. ^rend does this"
+ 			rend privateOwner: owner.
+ 			self hasExtension 
+ 				ifTrue: 
+ 					[""
+ 
+ 					extension actorState 
+ 						ifNotNil: [rend actorState: self extension actorState].
+ 					extension externalName 
+ 						ifNotNil: [rend setNameTo: self extension externalName].
+ 					extension player ifNotNil: 
+ 							[""
+ 
+ 							rend player: extension player.
+ 							extension player rawCostume: rend]].
+ 			^rend].
+ 	(rend := Morph new) color: Color transparent.
+ 	^rend!

Item was added:
+ ----- Method: Morph>>deepSubpartNamed: (in category '*Etoys-Squeakland-accessing') -----
+ deepSubpartNamed: aName
+ 	"Answer, from anywhere in the morph tree beneath the receiver, a subpart of the given name -- nil if none."
+ 
+ 	^ self allMorphs detect: [:m | m externalName = aName] ifNone: [nil]!

Item was changed:
  ----- Method: Morph>>defaultFloatPrecisionFor: (in category '*Etoys-scripting') -----
  defaultFloatPrecisionFor: aGetSelector
  	"Answer a number indicating the default float precision to be used in a numeric readout for which the receiver provides the data.   Individual morphs can override this.  Showing fractional values for readouts of getCursor was in response to an explicit request from ack"
  
+ 	(self renderedMorph decimalPlacesForGetter: aGetSelector) ifNotNilDo: [:places | ^ (Utilities floatPrecisionForDecimalPlaces: places)].
- 	(self renderedMorph decimalPlacesForGetter: aGetSelector) ifNotNil: [:places | ^ (Utilities floatPrecisionForDecimalPlaces: places)].
  
+ 	(#(getCursor getNumericValue getNumberAtCursor getCursorWrapped getScaleFactor) includes: aGetSelector)
- 	(#(getCursor getNumericValue getNumberAtCursor getCursorWrapped getScaleFactor getUnitVector getAlpha) includes: aGetSelector)
  		ifTrue:
  			[^ 0.01].
+ 
+ 	(#(getXOnGraph getYOnGraph getLocationOnGraph) includes: aGetSelector)
+ 		ifTrue:
+ 			[^ 0.1].
  	^ 1!

Item was added:
+ ----- Method: Morph>>defersHaloToInterior (in category '*Etoys-Squeakland-classification') -----
+ defersHaloToInterior
+ 	"Answer whether  when a halo-click goes down over some subobject within me, I should defer to it rather than seize the halo myself."
+ 
+ 	^ false!

Item was added:
+ ----- Method: Morph>>defersHaloToInteriorMorph: (in category '*Etoys-Squeakland-classification') -----
+ defersHaloToInteriorMorph: aMorph
+ 	"Answer whether  when a halo-click goes down over some subobject within me, I should defer to it rather than seize the halo myself."
+ 
+ 	^ false!

Item was changed:
  ----- Method: Morph>>definePath (in category '*Etoys-support') -----
  definePath
  	| points lastPoint aForm offset currentPoint dwell ownerPosition |
+ 	points _ OrderedCollection new: 70.
+ 	lastPoint _ nil.
+ 	aForm _ self imageForm.
+ 	offset _ aForm extent // 2.
+ 	ownerPosition _ owner position.
- 	points := OrderedCollection new: 70.
- 	lastPoint := nil.
- 	aForm := self imageForm.
- 	offset := aForm extent // 2.
- 	ownerPosition := owner position.
  	Cursor move show.
  	Sensor waitButton.
  	[Sensor anyButtonPressed and: [points size < 100]] whileTrue:
+ 		[currentPoint _ Sensor cursorPoint.
+ 		dwell _ 0.
- 		[currentPoint := Sensor cursorPoint.
- 		dwell := 0.
  		currentPoint = lastPoint
  			ifTrue:
+ 				[dwell _ dwell + 1.
- 				[dwell := dwell + 1.
  				((dwell \\ 1000) = 0) ifTrue:
  					[Beeper beep]]
  			ifFalse:
  				[self position: (currentPoint - offset).
  				self world displayWorld.
  				(Delay forMilliseconds: 20) wait.
  				points add: currentPoint.
+ 				lastPoint _ currentPoint]].
- 				lastPoint := currentPoint]].
  	points size > 1
  		ifFalse:
+ 			[self inform: 'no path obtained' translated]
- 			[self inform: 'no path obtained']
  		ifTrue:
  			[points size = 100 ifTrue: [self playSoundNamed: 'croak'].
  
+ 			"Transcript cr; show: 'path defined with
+ ', points size printString, ' points'."
- 			Transcript cr; show: 'path defined with
- ', points size printString, ' points'.
  			self renderedMorph setProperty: #pathPoints toValue: 
  				(points collect: [:p | p - ownerPosition])].
  
  	Cursor normal show
  		!

Item was added:
+ ----- Method: Morph>>doesColorAndBorder (in category '*Etoys-Squeakland-misc') -----
+ doesColorAndBorder
+ 	"Answer whether color and border protocols make sense for the receiver."
+ 
+ 	^ true!

Item was added:
+ ----- Method: Morph>>editMenuButtonDefinition (in category '*Etoys-Squeakland-display') -----
+ editMenuButtonDefinition
+ 	"Open up a single-method browser on the method that defines the  menu of the receiver obtained by clicking on the receiver's menuButton"
+ 
+ 	| mr |
+ 	mr _ MethodReference new setStandardClass: self class methodSymbol: #addMenuButtonItemsTo:.
+ 	self systemNavigation browseMessageList: {mr} name: self class name, ' menu definition' translated autoSelect: nil!

Item was added:
+ ----- Method: Morph>>embedEnabled (in category '*Etoys-Squeakland-meta-actions') -----
+ embedEnabled
+ 	"Answer whether there would be a reasonable set of alternatives for embedding."
+ 
+ 	^ self potentialEmbeddingTargets size > 1!

Item was added:
+ ----- Method: Morph>>enclosingTestTile (in category '*Etoys-Squeakland-e-toy support') -----
+ enclosingTestTile
+ 	"Return the next editor around the receiver"
+ 
+ 	| tested |
+ 	tested := owner.
+ 	[tested isNil] whileFalse: 
+ 			[(tested isMemberOf: CompoundTileMorph) ifTrue: [^tested].
+ 			tested := tested owner].
+ 	^nil!

Item was added:
+ ----- Method: Morph>>encouragesHaloTransferToEnclosedPasteUpMorph (in category '*Etoys-Squeakland-latter day support') -----
+ encouragesHaloTransferToEnclosedPasteUpMorph
+ 	"Whew.  Browse implementors of this to see what it's for..."
+ 
+ 	^ false!

Item was added:
+ ----- Method: Morph>>establishGraphPaperFrom: (in category '*Etoys-Squeakland-viewing') -----
+ establishGraphPaperFrom: graphPaperParameters
+ 	"Establish an InfiniteForm as the receiver's fill style, as defined the given graphPaperParameters; remember the graphPaperParameters provided in a property of the same name."
+ 
+ 	self setProperty: #graphPaperParameters toValue: graphPaperParameters.
+ 	self color: graphPaperParameters asInfiniteForm
+ !

Item was added:
+ ----- Method: Morph>>eventRoll (in category '*Etoys-Squeakland-accessing') -----
+ eventRoll
+ 	"Answer the containing EventRollMorph, nil if none."
+ 
+ 	^ self ownerThatIsA: EventRollMorph!

Item was added:
+ ----- Method: Morph>>finalTilePadSubmorph (in category '*Etoys-Squeakland-miscellaneous') -----
+ finalTilePadSubmorph
+ 	"Answer the final submorph of the receiver which is a TilePadMorph, nil if none."
+ 
+ 	^ submorphs reversed detect: [:m | m  isKindOf: TilePadMorph] ifNone: [nil]!

Item was added:
+ ----- Method: Morph>>fixLayoutOfSubmorphs (in category '*Etoys-Squeakland-e-toy support') -----
+ fixLayoutOfSubmorphs
+ 
+ 	self layoutChanged; fullBounds.
+ !

Item was added:
+ ----- Method: Morph>>fixUpCarets (in category '*Etoys-Squeakland-other') -----
+ fixUpCarets
+ 	"Make sure all the up-down and suffix arrows in the receiver are properly showing or hidden."
+ 
+ 	| wantsIt |
+ 	wantsIt := self topEditor notNil and: [self topEditor showingCarets].
+ 	(self allMorphs select: [:m | m isTileMorph]) do:
+ 		[:m | m addCaretsAsAppropriate: wantsIt]!

Item was changed:
  ----- Method: Morph>>followPath (in category '*Etoys-support') -----
  followPath
+ 	"Follow a prebuilt path."
+ 
+ 	| pathPoints offset morphToMove |
+ 	self isRenderer ifTrue: [^ self renderedMorph followPath].
+ 	(self hasProperty: #followingPath) ifTrue: [^ self].  "Don't let them build up."
+ 	(pathPoints _ self valueOfProperty: #pathPoints) ifNil: [^ self].
+ 	self setProperty: #followingPath toValue: true.
+ 	morphToMove := self topRendererOrSelf.
+ 	offset _ morphToMove owner position - (morphToMove extent // 2).
+ 	[[pathPoints do:
- 	| pathPoints offset |
- 	(pathPoints := self renderedMorph valueOfProperty: #pathPoints) ifNil: [^ Beeper beep].
- 	offset := owner position - (self extent // 2).
- 	pathPoints do:
  		[:aPoint |
+ 			morphToMove position: aPoint + offset.
- 			self position: aPoint + offset.
  			self world displayWorld.
+ 			(Delay forMilliseconds: 20) wait]]
+ 		ensure:
+ 			[self removeProperty: #followingPath]] fork!
- 			(Delay forMilliseconds: 20) wait]!

Item was added:
+ ----- Method: Morph>>fontsForText (in category '*Etoys-Squeakland-classification') -----
+ fontsForText
+ 	"I encapsulate a TextMorph, and need to show halo handles for text font commands."
+ 	^ false!

Item was added:
+ ----- Method: Morph>>growConcluded (in category '*Etoys-Squeakland-halo notification') -----
+ growConcluded
+ 	"After the user has manually resized the receiver, via its halo, this is called."!

Item was added:
+ ----- Method: Morph>>hideWillingnessToAcceptDropFeedback (in category '*Etoys-Squeakland-e-toy support') -----
+ hideWillingnessToAcceptDropFeedback
+ 	"Make the receiver stop looking ready to show some welcoming feedback"
+ 	
+ 	ActiveWorld removeHighlightFeedback
+ 	
+ 	!

Item was added:
+ ----- Method: Morph>>inspectMorphsProperties (in category '*Etoys-Squeakland-debug and other') -----
+ inspectMorphsProperties
+ 	"Open an inspector on the properties of the morph"
+ 
+ 	extension ifNil: [^ self inform: 'no properties to inspect, sorry' translated].
+ 	extension inspectAllPropertiesOf: self!

Item was added:
+ ----- Method: Morph>>justAddedAsTileRow (in category '*Etoys-Squeakland-layout') -----
+ justAddedAsTileRow
+ 	"The receiver was just added as a tile row in a Scriptor."!

Item was added:
+ ----- Method: Morph>>menuButton (in category '*Etoys-Squeakland-menu & halo') -----
+ menuButton
+ 	"Answer a button that brings up a menu."
+ 
+ 	| aButton form |
+ 	aButton _ IconicButton new target: self;
+ 		borderWidth: 0;
+ 		labelGraphic: (form := ScriptingSystem formAtKey: #MenuIcon);
+ 		color: Color transparent; 
+ 		actWhen: #buttonDown;
+ 		actionSelector: #offerMenu;
+ 		extent: form extent;
+ 		yourself.
+ 	aButton setBalloonText: 'click here to get a menu with further options' translated.
+ 	^ aButton
+ !

Item was added:
+ ----- Method: Morph>>mimeTypes (in category '*Etoys-Squeakland-drop outside') -----
+ mimeTypes
+ 	"Supported mime types for drag out"
+ 	^ #('image/png')!

Item was added:
+ ----- Method: Morph>>naviHeight: (in category '*Etoys-Squeakland-initialization') -----
+ naviHeight: anInteger
+ 	"Accept the argument as the height of the navigator.  This method serves as a backstop."
+ 
+ 
+ 	
+ !

Item was added:
+ ----- Method: Morph>>offerMenu (in category '*Etoys-Squeakland-menu & halo') -----
+ offerMenu
+ 	"A menu button was hit.  Offer a menu of options for the receiver."
+ 
+ 	| aMenu |
+ 	aMenu _ MenuMorph new defaultTarget: self.
+ 	self addMenuButtonItemsTo: aMenu.
+ 	aMenu popUpInWorld!

Item was added:
+ ----- Method: Morph>>openAppropriatePropertySheet (in category '*Etoys-Squeakland-meta-actions') -----
+ openAppropriatePropertySheet
+ 	"Open a property-sheet of the sort appropriate to the receiver.   Subclasses are expected to override this if they prefer a different kind of default property sheet."
+ 
+ 	self openAPropertySheet!

Item was added:
+ ----- Method: Morph>>openInWorldOrWorldlet (in category '*Etoys-Squeakland-initialization') -----
+ openInWorldOrWorldlet
+ 	"Open in the world-like creature affiliated with the active Hand."
+ 
+ 	| aRecorder aWorldlet |
+ 	(ActiveHand isKindOf: HandMorphForReplay) ifTrue:
+ 		[((aRecorder := ActiveHand recorder) isKindOf: MentoringEventRecorder)
+ 			ifTrue:
+ 				[aWorldlet := aRecorder contentArea.
+ 				self center: aWorldlet center.
+ 				aWorldlet addMorphFront: self.
+ 				^ self]].
+ 
+ 	self openInWorld!

Item was added:
+ ----- Method: Morph>>openNearTopLeftOfScreen (in category '*Etoys-Squeakland-initialization') -----
+ openNearTopLeftOfScreen
+ 	"Open the receiver in the world, and position it near the top-left corner of the screen."
+ 
+ 	self position: 40 at 40.
+ 	self openInWorld!

Item was added:
+ ----- Method: Morph>>outmostScriptEditor (in category '*Etoys-Squeakland-e-toy support') -----
+ outmostScriptEditor
+ 	"Return the next editor around the receiver"
+ 
+ 	| tested |
+ 	tested := owner.
+ 	[tested isNil] whileFalse: 
+ 			[(tested isMemberOf: ScriptEditorMorph) ifTrue: [^tested].
+ 			tested := tested owner].
+ 	^nil!

Item was added:
+ ----- Method: Morph>>ownerSatisfying: (in category '*Etoys-Squeakland-submorphs-accessing') -----
+ ownerSatisfying: aBlock
+ 	"Answer the nearest element in the receiver's owner chain that satisfies the block, nil if none."
+ 
+ 	owner ifNil: [^ nil].
+ 	(aBlock value: owner) ifTrue: [^ owner].
+ 	^ owner ownerSatisfying: aBlock!

Item was added:
+ ----- Method: Morph>>putEventsOnto: (in category '*Etoys-Squeakland-event roll') -----
+ putEventsOnto: aStream
+ 	"Write all of the events represented by the receiver in its current state onto the given stream."!

Item was added:
+ ----- Method: Morph>>putUpGraphPaperPanel (in category '*Etoys-Squeakland-e-toy support') -----
+ putUpGraphPaperPanel
+ 	"Put up a GraphPaperPanel for the receiver."
+ 
+ 	| aPanel |
+ 	aPanel := GraphPaperPanel basicNew.
+ 	aPanel targetMorph: self.
+ 	aPanel initialize.
+ 	aPanel openNearTarget!

Item was added:
+ ----- Method: Morph>>referenceWorld (in category '*Etoys-Squeakland-structure') -----
+ referenceWorld
+ 
+ 	ProjectLoading worldLoading ifNotNilDo: [:w | ^ w].
+ 	^ self referenceWorldViaOwnwer.
+ !

Item was added:
+ ----- Method: Morph>>referenceWorldViaOwnwer (in category '*Etoys-Squeakland-structure') -----
+ referenceWorldViaOwnwer
+ 	^owner isNil ifTrue: [self currentWorld] ifFalse: [owner referenceWorldViaOwnwer]!

Item was added:
+ ----- Method: Morph>>removeViewersOnSubsIn: (in category '*Etoys-Squeakland-e-toy support') -----
+ removeViewersOnSubsIn: aPresenter
+ 	"If any viewer is on a morph that is a submorph of me, delete it and its flap tab.  Good for deleting a book page."
+ 
+ 	| flapList morphList |
+ 	"enumerate referents of tabs"
+ 	flapList _ aPresenter associatedMorph submorphs select: [:mm | mm isKindOf: ViewerFlapTab].
+ 	morphList _ flapList collect: [:ff | ff scriptedPlayer costume].
+ 
+ 	"see if I am in owner chain of its morph"
+ 	morphList with: flapList do: [:mmm :aflap | (mmm hasOwner: self) ifTrue: [
+ 			aflap referent delete.
+ 			aflap delete]].!

Item was added:
+ ----- Method: Morph>>repelEnabledForMorph: (in category '*Etoys-Squeakland-dropping/grabbing') -----
+ repelEnabledForMorph: aMorph
+ 
+ 	^ false.
+ !

Item was added:
+ ----- Method: Morph>>restoreBaseGraphic (in category '*Etoys-support') -----
+ restoreBaseGraphic
+ 	"This can be overridden in subclasses"!

Item was added:
+ ----- Method: Morph>>rotationConcluded (in category '*Etoys-Squeakland-halo notification') -----
+ rotationConcluded
+ 	"React to the rotation having changed."
+ !

Item was added:
+ ----- Method: Morph>>rotationDegrees: (in category '*Etoys-Squeakland-geometry eToy') -----
+ rotationDegrees: aFloat 
+ 	^ self heading: aFloat!

Item was added:
+ ----- Method: Morph>>saveOnFile: (in category '*Etoys-Squeakland-fileIn/out') -----
+ saveOnFile: fileName 
+ 	| file |
+ 	file := [[FileStream newFileNamed: fileName]
+ 				on: FileExistsException
+ 				do: [:err | err defaultAction]]
+ 				on: Error
+ 				do: [:err | ^ self].
+ 	[file
+ 		nextPutAll: (SmartRefStream streamedRepresentationOf: self topRendererOrSelf)]
+ 		ensure: [file close]!

Item was added:
+ ----- Method: Morph>>say: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ say: aString
+ self showMessage: aString inBubbleType: #speech!

Item was added:
+ ----- Method: Morph>>sayGraphic: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ sayGraphic: aForm
+ self showGraphic: aForm inBubbleType: #speech!

Item was added:
+ ----- Method: Morph>>sayObject: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ sayObject: aPlayer
+ self showObject: aPlayer inBubbleType: #speech!

Item was added:
+ ----- Method: Morph>>scaleConcluded (in category '*Etoys-Squeakland-halo notification') -----
+ scaleConcluded
+ 	"After the user has manually scaled the receiver, via its halo, this is called."!

Item was added:
+ ----- Method: Morph>>showEmbedMenu (in category '*Etoys-Squeakland-meta-actions') -----
+ showEmbedMenu
+ 	"Put up a menu offering embed targets.  Emphasize the current position.  Theoretically this method will only be called when there are at least two alternatives."
+ 
+ 	| aMenu |
+ 	aMenu := self addEmbeddingMenuItemsTo: nil hand: ActiveHand.
+ 	aMenu title: ('embed {1} in...' translated format: {self externalName }).
+ 	aMenu popUpInWorld!

Item was added:
+ ----- Method: Morph>>showGraphic:inBubbleType: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ showGraphic: aForm inBubbleType: typeSymbol
+ | currentBubble |
+ currentBubble := self bubble.
+ currentBubble notNil ifTrue: [
+ 	(currentBubble form = aForm and: [currentBubble type = typeSymbol and: [currentBubble isInWorld]]) ifTrue: [^self].
+ 	currentBubble delete].
+ self bubble: (SpeechBubbleMorph form: aForm type: typeSymbol for: self).!

Item was added:
+ ----- Method: Morph>>showMessage:inBubbleType: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ showMessage: aString inBubbleType: typeSymbol
+ | currentBubble |
+ currentBubble := self bubble.
+ currentBubble notNil ifTrue: [
+ 	(currentBubble string = aString and: [currentBubble type = typeSymbol and: [currentBubble isInWorld]]) ifTrue: [^self].
+ 	currentBubble delete].
+ aString isEmpty ifTrue: [^self removeProperty: #bubble].
+ self bubble: (SpeechBubbleMorph string: aString type: typeSymbol for: self)!

Item was added:
+ ----- Method: Morph>>showObject:inBubbleType: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ showObject: aPlayer inBubbleType: typeSymbol
+ | currentBubble morph |
+ morph := aPlayer costume renderedMorph.
+ currentBubble := self bubble.
+ currentBubble notNil ifTrue: [
+ 	(currentBubble msgMorph = morph and: [currentBubble type = typeSymbol and: [currentBubble isInWorld]]) ifTrue: [^self].
+ 	currentBubble delete].
+ self bubble: (SpeechBubbleMorph morph: morph  type: typeSymbol for: self).!

Item was added:
+ ----- Method: Morph>>showWillingnessToAcceptDropFeedback (in category '*Etoys-Squeakland-e-toy support') -----
+ showWillingnessToAcceptDropFeedback
+ 	"Make the receiver look ready to show show some welcoming feedback"
+ 	
+ 	| aMorph |
+ 	aMorph _ RectangleMorph new bounds: self bounds..
+ 	aMorph beTransparent; borderWidth: 4; borderColor: (Color green); lock.
+ 	aMorph setProperty: #affilliatedPad toValue: (self ownerThatIsA: TilePadMorph).
+ 	ActiveWorld addHighlightMorph: aMorph for: self outmostScriptEditor!

Item was added:
+ ----- Method: Morph>>spanContainerVertically: (in category '*Etoys-Squeakland-geometry') -----
+ spanContainerVertically: aNumber
+ 	" Set the receiver understood to comprise the referent of a vertically oriented flap, such that its  position (top-left corner) and width will remain the same."
+ 
+ 	self height: aNumber!

Item was added:
+ ----- Method: Morph>>stagingArea (in category '*Etoys-Squeakland-geometry') -----
+ stagingArea
+ 	"Answer a containing Worldlet, or the World if none."
+ 
+ 	^ (self ownerThatIsA: Worldlet) ifNil: [ActiveWorld]!

Item was added:
+ ----- Method: Morph>>stopSayingOrThinking (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ stopSayingOrThinking
+ | currentBubble |
+ currentBubble := self bubble.
+ currentBubble isNil ifTrue: [^self].
+ currentBubble topRendererOrSelf delete.
+ self bubble: nil!

Item was added:
+ ----- Method: Morph>>suitableForDroppingIntoEventRoll (in category '*Etoys-Squeakland-event roll') -----
+ suitableForDroppingIntoEventRoll
+ 	"Answer whether the receiver is suitable for dropping into an Event Roll."
+ 
+ 	^ false!

Item was changed:
  ----- Method: Morph>>tanOButton (in category '*Etoys-support') -----
  tanOButton
  	"Answer a button with the old O on a tan background, targeted to self"
  
  	| aButton |
+ 	aButton := ThreePhaseButtonMorph
+ 		labelSymbol: #TanO
+ 		target: self
+ 		actionSelector: #delete
+ 		arguments: #().
- 	aButton := IconicButton new labelGraphic: (ScriptingSystem formAtKey: #TanO).
- 	aButton color: Color transparent; borderWidth: 0; shedSelvedge; actWhen: #buttonUp.
- 	aButton target: self.
  	^ aButton!

Item was added:
+ ----- Method: Morph>>targetFromMenu:popupAt: (in category '*Etoys-Squeakland-meta-actions') -----
+ targetFromMenu: aMenu popupAt: aPoint 
+ 	"Some other morph become target of the receiver"
+ 	| newTarget caption |
+ 	caption := 'Target for {1}' translated format: {self externalName}.
+ 	newTarget := aMenu startUpWithCaption: caption at: aPoint .
+ 	newTarget
+ 		ifNil: [^ self].
+ 	self target: newTarget!

Item was added:
+ ----- Method: Morph>>think: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ think: aString
+ self showMessage: aString inBubbleType: #thought!

Item was added:
+ ----- Method: Morph>>thinkGraphic: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ thinkGraphic: aForm
+ self showGraphic: aForm inBubbleType: #thought!

Item was added:
+ ----- Method: Morph>>thinkObject: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ thinkObject: aPlayer
+ self showObject: aPlayer inBubbleType: #thought!

Item was changed:
  ----- Method: Morph>>transparentSpacerOfSize: (in category '*Etoys-geometry') -----
  transparentSpacerOfSize: aPoint
+ 	^ (Morph new extent: aPoint asPoint) color: Color transparent!
- 	^ (Morph new extent: aPoint) color: Color transparent!

Item was added:
+ ----- Method: Morph>>traverseSearchForKedamaTurtleIfFound: (in category '*Etoys-Squeakland-translation') -----
+ traverseSearchForKedamaTurtleIfFound: aBlock
+ 	""
+ 
+ 	submorphs do: [:tile |
+ 		(tile isTileMorph) ifTrue: [
+ 			(tile actualObject isPlayerLike
+ 				and: [tile actualObject isPrototypeTurtlePlayer])
+ 					ifTrue: [aBlock value]].
+ 		tile traverseSearchForKedamaTurtleIfFound: aBlock
+ 	].
+ 
+ !

Item was added:
+ ----- Method: Morph>>unembedSubmorphsInWindow (in category '*Etoys-Squeakland-e-toy support') -----
+ unembedSubmorphsInWindow
+ 
+ 	| p |
+ 	self submorphs do: [:each |
+ 		(each hasProperty: #morphEmbeddedWindow) ifTrue: [
+ 			p _ each findA: PasteUpMorph.
+ 			p ifNotNil: [
+ 				p submorphs do: [:s | self addMorph: s behind: each].
+ 				each delete.
+ 			]
+ 		]
+ 	].
+ !

Item was added:
+ ----- Method: Morph>>useGraphPaperFill (in category '*Etoys-Squeakland-visual properties') -----
+ useGraphPaperFill
+ 	"Make receiver use a graph-paper fill"
+ 
+ 	self makeGraphPaper!

Item was added:
+ ----- Method: Morph>>wantsGraphPaperAlternative (in category '*Etoys-Squeakland-testing') -----
+ wantsGraphPaperAlternative
+ 	"Answer whether the receiver woud be willing to adopt graph paper as a fill style."
+ 
+ 	^ false!

Item was added:
+ ----- Method: Morph>>wantsTransfarHaloFromClick (in category '*Etoys-Squeakland-halos and balloon help') -----
+ wantsTransfarHaloFromClick
+ 	"If true, I want a halo when you click blue button at second"
+ 	^ self wantsHaloFromClick!

Item was added:
+ RectangleMorph subclass: #MorphExample
+ 	instanceVariableNames: 'phase ball star'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Demo'!
+ 
+ !MorphExample commentStamp: 'kfr 10/26/2003 18:38' prior: 0!
+ This is a example of how to use a morph. It consists of only two 
+ methods, initialize and step.
+ 
+ DoIt:
+ MorphExample new openInWorld.
+ 
+ 
+ 
+ !

Item was added:
+ ----- Method: MorphExample>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	phase _ 1.
+ 	self extent: 200 @ 200.
+ 	ball _ EllipseMorph new extent: 30 @ 30.
+ 	self
+ 		addMorph: ((star _ StarMorph new extent: 150 @ 150) center: self center)!

Item was added:
+ ----- Method: MorphExample>>step (in category 'stepping and presenter') -----
+ step
+ 	phase _ phase\\8 + 1.
+ 	phase = 1 ifTrue: [^ ball delete].
+ 	phase < 4 ifTrue:[^self].
+ 	phase = 4 ifTrue: [self addMorph: ball].
+ 	ball align: ball center with: (star vertices at: (phase-3*2)).!

Item was added:
+ ----- Method: MorphExtension>>inspectAllPropertiesOf: (in category '*Etoys-Squeakland-inspecting') -----
+ inspectAllPropertiesOf: aMorph
+ 	"Open an Inspector on all the properties.  This lets you see them but not in the initial instance actually modify them."
+ 
+ 	| aDict |
+ 	aDict _ otherProperties
+ 		ifNil:
+ 			[IdentityDictionary new]
+ 		ifNotNil:
+ 			[otherProperties copy].
+ 	((self class allInstVarNames reject: [:e | e = 'otherProperties']) collect: [:e | e asSymbol]) do:
+ 		[:var | (self instVarNamed: var) ifNotNilDo:
+ 			[:val | aDict add: (var -> val)]].
+ 
+ 	aDict inspectWithLabel: 'Properties of ', aMorph defaultLabelForInspector!

Item was added:
+ ----- Method: MorphExtension>>inspectElementFor: (in category '*Etoys-Squeakland-inspecting') -----
+ inspectElementFor: aMorph
+ 	"Create and schedule an Inspector on the otherProperties and the 
+ 	named properties, on behalf of the given morph"
+ 
+ 	| key obj names toInspect |
+ 	(names _  self sortedPropertyNames) ifEmpty: [^ self].
+ 	key _ (SelectionMenu selections: names)
+ 				startUpWithCaption: 'Inspect which property?'.
+ 	key
+ 		ifNil: [^ self].
+ 	obj := otherProperties
+ 		ifNil:
+ 			 ['nOT a vALuE']
+ 		ifNotNil:
+ 			[otherProperties
+ 				at: key
+ 				ifAbsent: ['nOT a vALuE']].
+ 	toInspect := obj = 'nOT a vALuE'
+ 		ifTrue: [(self perform: key)  "named properties"]
+ 		ifFalse: [obj ].
+ 	toInspect inspectWithLabel: 'value of ', key, ' in ', aMorph defaultLabelForInspector!

Item was added:
+ Controller subclass: #MorphWorldController
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-ST80-Morphic'!
+ 
+ !MorphWorldController commentStamp: '<historical>' prior: 0!
+ I am a controller for SceneViews. I support gestures for scrolling, click-selection, and area selection of scene glyphs. (See the class comment in GestureController for more details about gestures.) I also support construction operations such as inserting new glyphs and merging glyphs to make them share a common point.
+ 
+ The mapping of gestures to actions is as follows (see GestureController comment for more about gestures):
+ 
+   Click:
+ 	click on glyph				select glyph
+ 	shift-click on glyph			toggle selection of that glyph
+ 	click on background			clear selection
+   Double click:
+ 	double-click on glyph			inspect glyph
+ 	double-click on background		select all
+   Hold/Drag/Sweep:
+ 	hold (no movement)			yellow-button menu
+ 	drag (up/left movement)		scrolling hand
+ 	sweep (down/right movement)	select glyphs in region
+ 	shift-sweep					toggle selection of glyphs in region
+ !

Item was added:
+ ----- Method: MorphWorldController>>controlActivity (in category 'control defaults') -----
+ controlActivity
+ 	"Do one step of the Morphic interaction loop. Called repeatedly while window is active."
+ 
+ 	model doOneCycle.
+ !

Item was added:
+ ----- Method: MorphWorldController>>controlInitialize (in category 'basic control sequence') -----
+ controlInitialize
+ 	"This window is becoming active."
+ 
+ 	true ifTrue: [model becomeTheActiveWorldWith: nil].
+ 
+ 	model canvas ifNil: [  "i.e., only on first entry"
+ 		"In case of, eg, inspect during balloon help..."
+ 		model submorphsDo: [:m |  "delete any existing balloons"
+ 			(m isKindOf: BalloonMorph) ifTrue: [m delete]].
+ 
+ 		model handsDo: [:h | h initForEvents].
+ 		view displayView].  "initializes the WorldMorph's canvas"
+ !

Item was added:
+ ----- Method: MorphWorldController>>controlLoop (in category 'basic control sequence') -----
+ controlLoop 
+ 	"Overridden to keep control active when the hand goes out of the view"
+ 
+ 	| db |
+ 	[self viewHasCursor  "working in the window"
+ 		or: [Sensor noButtonPressed  "wandering with no button pressed"
+ 		or: [model primaryHand submorphs size > 0  "dragging something outside"]]]
+ 		whileTrue:   "... in other words anything but clicking outside"
+ 			[self controlActivity.
+ 
+ 			"Check for reframing since we hold control here"
+ 			db _ view superView displayBox.
+ 			view superView controller checkForReframe.
+ 			db = view superView displayBox ifFalse:
+ 				[self controlInitialize "reframe world if bounds changed"]].
+ !

Item was added:
+ ----- Method: MorphWorldController>>controlTerminate (in category 'basic control sequence') -----
+ controlTerminate 
+ 	"This window is becoming inactive; restore the normal cursor."
+ 
+ 	Cursor normal show.
+ 	ActiveWorld _ ActiveHand _ ActiveEvent _ nil!

Item was added:
+ ----- Method: MorphWorldController>>isControlActive (in category 'control defaults') -----
+ isControlActive
+ 
+ 	^ sensor redButtonPressed or: [self viewHasCursor]!

Item was added:
+ View subclass: #MorphWorldView
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'FullColorWhenInactive'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-ST80-Morphic'!
+ 
+ !MorphWorldView commentStamp: '<historical>' prior: 0!
+ I am a view used to display a Scene. I may be scrolled by adjusting my offset. My default controller is SceneController.
+ 
+ SceneViews encapsulate the notion of a changing foreground and a fixed background during interactive updates. During an interaction (such as dragging), some of the glyphs will not change location or appearance. These are part of the "background". All glyphs that may change (the "foreground" glyphs) are painted against this unchanging backdrop during the interaction.
+ 
+ Instance Variables:
+ 	offset				the current offset of this view (used for scrolling)
+ 	enclosingRect 		a rectangle large enough to contain all the objects in the scene, plus a small border (this is a cache that must be recomputed when glyphs are moved, added, or removed from the scene)
+ 	backgroundForm		a <Form> containing the fixed background
+ 	visibleForeground		the glyphs that are changing but not selected during an interaction
+ 	selectedForeground	the selected glyphs that are changing during an interaction!

Item was added:
+ ----- Method: MorphWorldView class>>convertToMVCWiWPasteUpMorph (in category 'instance creation') -----
+ convertToMVCWiWPasteUpMorph
+ 	"
+ MorphWorldView convertToMVCWiWPasteUpMorph
+ "
+ 
+ 	| current w newModel topView |
+ 	Smalltalk isMorphic ifTrue: [^self inform: 'do this in MVC'].
+ 	current := self allInstances 
+ 				select: [:each | each model class == PasteUpMorph].
+ 	current do: 
+ 			[:oldWorldView | 
+ 			w := MVCWiWPasteUpMorph newWorldForProject: nil.
+ 			w
+ 				color: oldWorldView model color;
+ 				addAllMorphs: oldWorldView model submorphs.
+ 			newModel := CautiousModel new initialExtent: 300 @ 300.
+ 			topView := self fullColorWhenInactive 
+ 						ifTrue: [ColorSystemView new]
+ 						ifFalse: [StandardSystemView new].
+ 			topView
+ 				model: newModel;
+ 				label: oldWorldView topView label;
+ 				borderWidth: 1;
+ 				addSubView: (self new model: w);
+ 				backgroundColor: w color.
+ 			topView controller openNoTerminate.
+ 			topView reframeTo: (oldWorldView topView expandedFrame 
+ 						expandBy: (0 @ 0 extent: 0 @ topView labelHeight)).
+ 			oldWorldView topView controller closeAndUnscheduleNoTerminate].
+ 	ScheduledControllers restore.
+ 	Processor terminateActive!

Item was added:
+ ----- Method: MorphWorldView class>>fullColorWhenInactive (in category 'instance creation') -----
+ fullColorWhenInactive
+ 
+ 	FullColorWhenInactive ifNil: [FullColorWhenInactive _ true].
+ 	^ FullColorWhenInactive
+ !

Item was added:
+ ----- Method: MorphWorldView class>>fullColorWhenInactive: (in category 'instance creation') -----
+ fullColorWhenInactive: fullColor
+ 	"MorphWorldView fullColorWhenInactive: true"
+ 	"If FullColorWhenInactive is true then WorldMorphViews will created inside StandardSystemViews that cache their contents in full-color when the window is inactive. If it is false, only a half-tone gray approximation of the colors will be cached to save space."
+ 
+ 	FullColorWhenInactive _ fullColor.
+ 
+ 	"Retroactively convert all extant windows"
+ 	((fullColor ifTrue: [StandardSystemView] ifFalse: [ColorSystemView])
+ 		allInstances select:
+ 			[:v | v subViews notNil and: [v subViews isEmpty not and: [v firstSubView isKindOf: MorphWorldView]]])
+ 		do: [:v | v uncacheBits.
+ 			v controller toggleTwoTone]!

Item was added:
+ ----- Method: MorphWorldView class>>openOn: (in category 'instance creation') -----
+ openOn: aMorphWorld
+ 	"Open a view on the given WorldMorph."
+ 
+ 	self openOn: aMorphWorld label: 'A Morphic World'.!

Item was added:
+ ----- Method: MorphWorldView class>>openOn:label: (in category 'instance creation') -----
+ openOn: aWorldMorph label: aString
+ 	"Open a view with the given label on the given WorldMorph."
+ 	^ self openOn: aWorldMorph label: aString model: (CautiousModel new initialExtent: aWorldMorph initialExtent)!

Item was added:
+ ----- Method: MorphWorldView class>>openOn:label:cautionOnClose: (in category 'instance creation') -----
+ openOn: aWorldMorph label: aString cautionOnClose: aBoolean
+ 	"Open a view with the given label on the given WorldMorph."
+ 	| aModel |
+ 	aModel _ aBoolean
+ 		ifTrue:		[CautiousModel new]
+ 		ifFalse:		[WorldViewModel new].
+ 	^ self openOn: aWorldMorph label: aString model: (aModel initialExtent: aWorldMorph initialExtent)!

Item was added:
+ ----- Method: MorphWorldView class>>openOn:label:extent: (in category 'instance creation') -----
+ openOn: aWorldMorph label: aString extent: aPoint
+ 	"Open a view with the given label and extent on the given WorldMorph."
+ 
+ 	^ self openOn: aWorldMorph
+ 		label: aString
+ 		model: (CautiousModel new initialExtent: aPoint)
+ !

Item was added:
+ ----- Method: MorphWorldView class>>openOn:label:model: (in category 'instance creation') -----
+ openOn: aWorldMorph label: aString model: aModel 
+ 	"Open a view with the given label on the given WorldMorph."
+ 
+ 	| topView |
+ 	topView := self fullColorWhenInactive 
+ 				ifTrue: [topView := ColorSystemView new]
+ 				ifFalse: [topView := StandardSystemView new].
+ 	topView
+ 		model: aModel;
+ 		label: aString;
+ 		borderWidth: 1;
+ 		addSubView: (self new model: aWorldMorph);
+ 		backgroundColor: aWorldMorph color.
+ 	"minimumSize: aWorldMorph extent + (2 at 2); "	"add border width"
+ 	topView controller open!

Item was added:
+ ----- Method: MorphWorldView class>>openWorld (in category 'instance creation') -----
+ openWorld
+ 
+ 	| w |
+ 	(w _ MVCWiWPasteUpMorph newWorldForProject: nil).
+ 	w bounds: (0 at 0 extent: 400 at 300).
+ 	self openOn: w
+ 		label: 'A Morphic World'
+ 		extent: w fullBounds extent + 2.
+ !

Item was added:
+ ----- Method: MorphWorldView class>>openWorldWith:labelled: (in category 'instance creation') -----
+ openWorldWith: aMorph labelled: labelString
+ 
+ 	| w |
+ 	(w _ MVCWiWPasteUpMorph newWorldForProject: nil) addMorph: aMorph.
+ 	w extent: aMorph fullBounds extent.
+ 	w startSteppingSubmorphsOf: aMorph.
+ 	self openOn: w
+ 		label: labelString
+ 		extent: w fullBounds extent + 2.
+ !

Item was added:
+ ----- Method: MorphWorldView>>computeInsetDisplayBox (in category 'private') -----
+ computeInsetDisplayBox
+ 	"This overrides the same method in View.  (It avoids using displayTransform: because it can return inaccurate results, causing a MorphWorldView's inset display box to creep inward when resized.)"
+ 
+ 	^superView insetDisplayBox insetBy: borderWidth!

Item was added:
+ ----- Method: MorphWorldView>>deEmphasizeView (in category 'deEmphasizing') -----
+ deEmphasizeView 
+ 	"This window is becoming inactive."
+ 
+ 	Cursor normal show.    "restore the normal cursor"
+ 	model deEmphasizeViewMVC: self topView cacheBitsAsTwoTone.
+ !

Item was added:
+ ----- Method: MorphWorldView>>defaultControllerClass (in category 'controller access') -----
+ defaultControllerClass
+ 
+ 	^ MorphWorldController!

Item was added:
+ ----- Method: MorphWorldView>>displayView (in category 'displaying') -----
+ displayView
+ 	"This method is called by the system when the top view is framed or moved."
+ 	| topView |
+ 	model viewBox: self insetDisplayBox.
+ 	self updateSubWindowExtent.
+ 	topView _ self topView.
+ 	(topView == ScheduledControllers scheduledControllers first view
+ 		or: [topView cacheBitsAsTwoTone not])
+ 		ifTrue: [model displayWorldSafely]
+ 		ifFalse: [model displayWorldAsTwoTone].  "just restoring the screen"!

Item was added:
+ ----- Method: MorphWorldView>>update: (in category 'updating') -----
+ update: symbol
+ 
+ 	^ symbol == #newColor
+ 		ifTrue: [self topView backgroundColor: model color dominantColor; uncacheBits; display]
+ 		ifFalse: [super update: symbol].
+ !

Item was added:
+ ----- Method: MorphWorldView>>updateSubWindowExtent (in category 'as yet unclassified') -----
+ updateSubWindowExtent
+ 	"If this MorphWorldView represents a single Morphic SystemWindow, then update that window to match the size of the WorldView."
+ 
+ 	| numMorphs subWindow scrollBarWidth |
+ 	numMorphs := model submorphs size.
+ 	"(Allow for the existence of an extra NewHandleMorph (for resizing).)"
+ 	(numMorphs = 0 or: [numMorphs > 2]) ifTrue: [^self].
+ 	subWindow := model submorphs detect: [:ea | ea respondsTo: #label]
+ 				ifNone: [^self].
+ 	superView label = subWindow label ifFalse: [^self].
+ 	scrollBarWidth := (Preferences valueOfFlag: #inboardScrollbars) 
+ 				ifTrue: [0]
+ 				ifFalse: [14]. 
+ 	subWindow position: model position + (scrollBarWidth @ -16).	"adjust for WiW changes"
+ 	subWindow extent: model extent - (scrollBarWidth @ -16).
+ 	subWindow isActive ifFalse: [subWindow activate]!

Item was added:
+ ----- Method: MorphicEvent>>addKeystrokeEventsTo: (in category '*Etoys-Squeakland-debugging') -----
+ addKeystrokeEventsTo: aStream
+ 	"Add any keystroke events I may have to offer to a stream.  Used in event-tape parsing.  Only events that have keystrokes to offer need reimplement this."!

Item was added:
+ ----- Method: MorphicEvent>>duration (in category '*Etoys-Squeakland-accessing') -----
+ duration
+ 	"Answer the duration of the event, in seconds."
+ 
+ 	^ 0!

Item was added:
+ ----- Method: MorphicEvent>>durationInMilliseconds (in category '*Etoys-Squeakland-accessing') -----
+ durationInMilliseconds
+ 	"Answer the duration of the activity represented by the receiver, in milliseconds."
+ 
+ 	^ 0!

Item was added:
+ ----- Method: MorphicEvent>>expandOnto: (in category '*Etoys-Squeakland-processing') -----
+ expandOnto: aStream
+ 	"Place all the receiver's events onto a Stream"
+ 
+ 	aStream nextPut: self!

Item was added:
+ ----- Method: MorphicEvent>>position: (in category '*Etoys-Squeakland-accessing') -----
+ position: aPoint
+ 	"Set my position, if it makes sense for me."!

Item was added:
+ ----- Method: MorphicEvent>>timeStamp: (in category '*Etoys-Squeakland-accessing') -----
+ timeStamp: aNumber 
+ 	"Stuff in a new value for my time stamp."
+ 
+ 	timeStamp := aNumber!

Item was added:
+ ----- Method: MorphicEvent>>translateBy: (in category '*Etoys-Squeakland-transforming') -----
+ translateBy: delta
+ 	"Reposition the receiver by delta.  For non-UI events, this is meaningless"!

Item was added:
+ ----- Method: MorphicEventDispatcher>>relocateMorphIfnecessary:within: (in category '*Etoys-Squeakland-private') -----
+ relocateMorphIfnecessary: aMorph within: aWorldMorph
+ 
+ 	| morphBounds morphCenter worldBounds |
+ 	morphBounds _ aMorph bounds.
+ 	worldBounds _ aWorldMorph bounds.
+ 	(morphBounds intersects: (worldBounds insetBy: 4)) ifFalse: [
+ 		morphCenter _ morphBounds center.
+ 		(morphCenter x < worldBounds left) ifTrue: [
+ 			aMorph right: worldBounds left + 16.
+ 		].
+ 		(morphCenter x > worldBounds right) ifTrue: [
+ 			aMorph left: worldBounds right - 16
+ 		].
+ 		(morphCenter y < worldBounds top) ifTrue: [
+ 			aMorph bottom: worldBounds top + 16.
+ 		].
+ 		(morphCenter y > worldBounds bottom) ifTrue: [
+ 			aMorph top: worldBounds bottom - 16
+ 		].
+ 	].
+ !

Item was added:
+ PackageInfo subclass: #MorphicGamesInfo
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!
+ 
+ !MorphicGamesInfo commentStamp: 'asm 7/5/2003 15:59' prior: 0!
+ to create the package:
+ 
+ in a 5325 image
+ 	-file in SARBuilder
+ 
+ SARPackageDumper 	fileOutPackageNamed: 'Morphic-Games' 
+ 					as: (FileDirectory default nextNameFor: 'Morphic-Games' extension: 'sar')!

Item was added:
+ ----- Method: MorphicGamesInfo>>changesText (in category 'introspection') -----
+ changesText
+ 	^'
+ version 6: included Rick McGeer''s Chess Castling Fix
+ version 5: included Atomic (some changes were needed to make it work in 3.7) and some Babel stuff
+ version 4: includes Andreas Raab''s rewrite of ChessConstants as declarative pool (update 5325)
+ version 3: 	-added one change by the KCP team
+ 			-Chess its playing again
+ version 2: applied changes by the MCP team'!

Item was added:
+ ----- Method: MorphicGamesInfo>>postscriptText (in category 'introspection') -----
+ postscriptText
+ 	"Executed after load"
+ 	^ 'Utilities informUser: ''Generating Games thumbnails in PartsBin, please wait...'' during: [
+ 	PartsBin clearThumbnailCache.
+ 	PartsBin cacheAllThumbnails.
+ ].
+ "End ', self packageName, '"'!

Item was added:
+ ----- Method: MorphicGamesInfo>>readmeText (in category 'introspection') -----
+ readmeText
+ 	^'Morphic-Games has the games that were in the image before 3.6:
+ Chess, Chinese Checkers, Cipher, Crostic, FreeCell, Mines, Same and Tetris.
+ plus Atomic'!

Item was added:
+ AppRegistry subclass: #MorphicTextEditor
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Applications'!

Item was added:
+ ----- Method: MorphicUnknownEvent>>duration (in category '*Etoys-Squeakland-accessing') -----
+ duration
+ 	"Answer the duration of the event.  Some subclasses make good use of this."
+ 
+ 	^ 0!

Item was added:
+ ----- Method: MorphicUnknownEvent>>endTime (in category '*Etoys-Squeakland-accessing') -----
+ endTime
+ 	"Answer the endTime."
+ 
+ 	^ timeStamp!

Item was added:
+ Morph subclass: #MouseActionIndicatorMorph
+ 	instanceVariableNames: 'siblings'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Widgets'!
+ 
+ !MouseActionIndicatorMorph commentStamp: '<historical>' prior: 0!
+ I am used to highlight morphs which have a special mouseup action!

Item was added:
+ ----- Method: MouseActionIndicatorMorph class>>world:inner:outer:color: (in category 'as yet unclassified') -----
+ world: aWorld inner: innerRectangle outer: outerRectangle color: aColor
+ 
+ 	| allRects allMorphs |
+ 
+ 	allRects _ outerRectangle areasOutside: innerRectangle.
+ 	allMorphs _ allRects collect: [ :each |
+ 		self new bounds: each; color: aColor
+ 	].
+ 	allMorphs do: [ :each |
+ 		each siblings: allMorphs; openInWorld: aWorld
+ 	].
+ 	^allMorphs
+ 
+ 
+ !

Item was added:
+ ----- Method: MouseActionIndicatorMorph>>deleteWithSiblings (in category 'as yet unclassified') -----
+ deleteWithSiblings
+ 
+ 	siblings do: [ :each | each delete]
+ !

Item was added:
+ ----- Method: MouseActionIndicatorMorph>>handlesMouseOver: (in category 'event handling') -----
+ handlesMouseOver: evt
+ 
+ 	^true!

Item was added:
+ ----- Method: MouseActionIndicatorMorph>>handlesMouseOverDragging: (in category 'event handling') -----
+ handlesMouseOverDragging: evt
+ 
+ 	^true!

Item was added:
+ ----- Method: MouseActionIndicatorMorph>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	super initialize.
+ 	siblings _ #().!

Item was added:
+ ----- Method: MouseActionIndicatorMorph>>mouseEnter: (in category 'event handling') -----
+ mouseEnter: evt
+ 
+ 	self deleteWithSiblings
+ !

Item was added:
+ ----- Method: MouseActionIndicatorMorph>>mouseEnterDragging: (in category 'event handling') -----
+ mouseEnterDragging: evt
+ 
+ 	self deleteWithSiblings
+ !

Item was added:
+ ----- Method: MouseActionIndicatorMorph>>siblings: (in category 'as yet unclassified') -----
+ siblings: aCollection
+ 
+ 	siblings _ aCollection.
+ !

Item was added:
+ MouseSensorMorph subclass: #MouseDownMorph
+ 	instanceVariableNames: 'mouseDownSelector mouseMoveSelector mouseUpSelector'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Components'!

Item was added:
+ ----- Method: MouseDownMorph>>addCustomMenuItems:hand: (in category 'menu') -----
+ addCustomMenuItems: aCustomMenu hand: aHandMorph
+ 	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ "template..."
+ 	aCustomMenu addLine.
+ 	aCustomMenu add: 'set variable name...' translated action: #renameMe.
+ 	aCustomMenu addLine.
+ 	aCustomMenu add: 'plug mouseDown to model slot' translated action: #plugMouseDownToSlot.
+ 	aCustomMenu add: 'plug mouseMove to model slot' translated action: #plugMouseMoveToSlot.
+ 	aCustomMenu add: 'plug all to model slots' translated action: #plugAllToSlots.
+ 	aCustomMenu addLine.
+ 	aCustomMenu add: 'plug mouseDown to model' translated action: #plugMouseDownToModel.
+ 	aCustomMenu add: 'plug mouseMove to model' translated action: #plugMouseMoveToModel.
+ 	aCustomMenu add: 'plug all to model' translated action: #plugAllToModel.
+ 	aCustomMenu addLine.
+ 	aCustomMenu add: 'set target...' translated action: #setTarget.
+ 	aCustomMenu add: 'set mouseDown selector...' translated action: #setMouseDownSelector.
+ 	aCustomMenu add: 'set mouseMove selector...' translated action: #setMouseMoveSelector.
+ 	aCustomMenu add: 'set mouseUp selector...' translated action: #setMouseUpSelector.
+ !

Item was added:
+ ----- Method: MouseDownMorph>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: evt 
+ 	^model notNil!

Item was added:
+ ----- Method: MouseDownMorph>>mouseDown: (in category 'event handling') -----
+ mouseDown: event
+ 	"Relay a mouseDown event to my model."
+ 
+ 	mouseDownSelector ifNotNil:
+ 		[mouseDownSelector numArgs = 0
+ 			ifTrue: [^ model perform: mouseDownSelector].
+ 		mouseDownSelector numArgs = 1
+ 			ifTrue: [^ model perform: mouseDownSelector with: event].
+ 		mouseDownSelector numArgs = 2
+ 			ifTrue: [^ model perform: mouseDownSelector with: true with: event].
+ 		^ self error: 'mouseDownselector must take 0, 1, or 2 arguments']!

Item was added:
+ ----- Method: MouseDownMorph>>mouseMove: (in category 'event handling') -----
+ mouseMove: event
+ 	"Relay a mouseMove event to my model."
+ 
+ 	mouseMoveSelector ifNotNil:
+ 		[mouseMoveSelector numArgs = 0
+ 			ifTrue: [^ model perform: mouseMoveSelector].
+ 		mouseMoveSelector numArgs = 1
+ 			ifTrue: [^ model perform: mouseMoveSelector with: event cursorPoint].
+ 		mouseMoveSelector numArgs = 2
+ 			ifTrue: [^ model perform: mouseMoveSelector with: event cursorPoint with: event].
+ 		^ self error: 'mouseMoveSelector must take 0, 1, or 2 arguments']!

Item was added:
+ ----- Method: MouseDownMorph>>mouseUp: (in category 'event handling') -----
+ mouseUp: event
+ 	"Relay a mouseUp event to my model."
+ 
+ 	mouseUpSelector ifNotNil:
+ 		[mouseUpSelector numArgs = 0
+ 			ifTrue: [^ model perform: mouseUpSelector].
+ 		mouseUpSelector numArgs = 1
+ 			ifTrue: [^ model perform: mouseUpSelector with: event].
+ 		^ self error: 'mouseUpselector must take 0, or 1 argument'].
+ 	mouseDownSelector ifNotNil:
+ 		["Or send mouseDown: false..."
+ 		mouseDownSelector numArgs = 2
+ 			ifTrue: [^ model perform: mouseDownSelector with: false with: event].
+ 		^ self error: 'mouseDownselector must take 2 arguments']!

Item was added:
+ ----- Method: MouseDownMorph>>plugAllToModel (in category 'menu') -----
+ plugAllToModel
+ 	self plugMouseDownToModel; plugMouseMoveToSlot!

Item was added:
+ ----- Method: MouseDownMorph>>plugAllToSlots (in category 'menu') -----
+ plugAllToSlots
+ 	self plugMouseDownToSlot; plugMouseMoveToSlot.
+ !

Item was added:
+ ----- Method: MouseDownMorph>>plugMouseDownToModel (in category 'menu') -----
+ plugMouseDownToModel
+ 	mouseDownSelector _ (self knownName , 'MouseDown:event:') asSymbol.
+ 	model class compile: (
+ 
+ '&nameMouseDown: trueOrFalse event: event
+ 	"A mouseDown event has occurred.
+ 	Add code to handle it here below..."'
+ 
+ 			copyReplaceAll: '&name' with: self knownName)
+ 		classified: 'input events' notifying: nil!

Item was added:
+ ----- Method: MouseDownMorph>>plugMouseDownToSlot (in category 'menu') -----
+ plugMouseDownToSlot
+ 	| varName |
+ 	mouseDownSelector _ (self knownName , 'MouseDown:event:') asSymbol.
+ 	varName _ self knownName , 'MouseDown'.
+ 	model class addSlotNamed: varName.
+ 	model class compile: (
+ 
+ '&name: trueOrFalse event: event
+ 	"A mouseDown event has occurred.
+ 	Add code to handle it here below..."
+ 	&name _ trueOrFalse.'
+ 
+ 			copyReplaceAll: '&name' with: varName)
+ 		classified: 'input events' notifying: nil!

Item was added:
+ ----- Method: MouseDownMorph>>plugMouseMoveToModel (in category 'menu') -----
+ plugMouseMoveToModel
+ 	mouseMoveSelector _ (self knownName , 'MouseMove:event:') asSymbol.
+ 	model class compile: (
+ 
+ '&nameMouseMove: location event: event
+ 	"A mouseMove event has occurred.
+ 	Add code to handle it here below..."'
+ 
+ 			copyReplaceAll: '&name' with: self knownName)
+ 		classified: 'input events' notifying: nil!

Item was added:
+ ----- Method: MouseDownMorph>>plugMouseMoveToSlot (in category 'menu') -----
+ plugMouseMoveToSlot
+ 	| varName |
+ 	mouseMoveSelector _ (self knownName , 'MouseMove:event:') asSymbol.
+ 	varName _ self knownName , 'MouseMove'.
+ 	model class addSlotNamed: varName.
+ 	model class compile: (
+ 
+ '&name: location event: event
+ 	"A mouseMove event has occurred.
+ 	Add code to handle it here below..."
+ 	&name _ location.'
+ 
+ 			copyReplaceAll: '&name' with: varName)
+ 		classified: 'input events' notifying: nil!

Item was added:
+ PasteUpMorph subclass: #MouseEventEditor
+ 	instanceVariableNames: 'mouseEventSequenceMorph'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !MouseEventEditor commentStamp: 'sw 12/24/2006 16:58' prior: 0!
+ A nascent graphical editor for the mouse events constituting a mouse-event sequence.  This is just a beginning -- there is no UI yet for propagating the results of edits back to the originating mouse-event sequence.!

Item was added:
+ ----- Method: MouseEventEditor>>discRepresentingEvent:index: (in category 'initialization') -----
+ discRepresentingEvent: evt index: anIndex
+ 	"Answer a disk to represent the given event."
+ 
+ 	| aMorph |
+ 	aMorph := MouseEventToken new.
+ 	aMorph index: anIndex event: evt.
+ 	^ aMorph!

Item was added:
+ ----- Method: MouseEventEditor>>initializeFor:forEventRoll: (in category 'initialization') -----
+ initializeFor: aMouseEventSequenceMorph forEventRoll: aRoll
+ 	"Initialize the receiver as an editor for the given mouse-event-sequence and event-roll."
+ 
+ 	| aTheatre aMorph |
+ 	self color: (Color green muchLighter alpha: 0.7).
+ 	aTheatre := aRoll eventTheatre.
+ 	mouseEventSequenceMorph := aMouseEventSequenceMorph.
+ 	self extent: aTheatre initialContentArea extent.
+ 	self setNameTo: 'mouse event editor'.
+ 	mouseEventSequenceMorph events doWithIndex:
+ 		[:evt :index |
+ 			aMorph := self discRepresentingEvent: evt index: index.
+ 			aMorph center: evt position - aTheatre initialContentArea topLeft.
+ 			self addMorphFront: aMorph]!

Item was added:
+ ----- Method: MouseEventEditor>>wantsToBeDroppedInto: (in category 'drag and drop') -----
+ wantsToBeDroppedInto: aMorph
+ 	"Return true if it's okay to drop the receiver into aMorph."
+ 
+ 	^ aMorph isWorldMorph "only into worlds"!

Item was added:
+ EventSequence subclass: #MouseEventSequence
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !MouseEventSequence commentStamp: 'sw 12/21/2006 22:53' prior: 0!
+ A combination event embodying a mouse sequence, starting either with a mouse-down or a mouse-up, and ending with either a mouse-move (if it started with a mouse-down) or a mouse-up (otherwise.)
+ !

Item was added:
+ EventMorph subclass: #MouseEventSequenceMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !MouseEventSequenceMorph commentStamp: 'sw 12/21/2006 22:44' prior: 0!
+ A morph representing a related sequence of mouse events.!

Item was added:
+ ----- Method: MouseEventSequenceMorph>>addCustomMenuItems:hand: (in category 'menu') -----
+ addCustomMenuItems: aMenu hand: aHand
+ 	"Add morph-specific items to the given menu which was invoked by the given hand."
+ 
+ 	super addCustomMenuItems: aMenu hand: aHand.
+ 	aMenu addLine.
+ 	aMenu addTranslatedList: #(
+ 		( 'graphical view'	openExpandedView 'Lets you visualize all the individual events that constitute this sequence in an onionskin overlay to the event theatre.')
+ 		('textual view' openTextualView 'Presents the constituent events of this sequence in a scrolling list for your inspection.')) translatedNoop!

Item was added:
+ ----- Method: MouseEventSequenceMorph>>durationInMilliseconds (in category 'accessing') -----
+ durationInMilliseconds
+ 	"Answer the duration in milliseconds"
+ 
+ 	^ event durationInMilliseconds!

Item was added:
+ ----- Method: MouseEventSequenceMorph>>events (in category 'accessing') -----
+ events
+ 	"Answer the actual events comprising the receiver.  My direct 'event' is a contrived MouseEventSequenceEvent; this method reaches into that sequence event and retrieves its constituent native events."
+ 
+ 	^ event events!

Item was added:
+ ----- Method: MouseEventSequenceMorph>>growConcluded (in category 'processing') -----
+ growConcluded
+ 	"After the user has manually resized the receiver, via its halo, this is called."
+ 
+ 	| leftTime rightTime newSpan oldSpan ratio  baseline |
+ 	self eventRoll ifNotNilDo: [:roll |
+ 		leftTime :=roll timeStampForCurrentPositionOf: self.
+ 		rightTime :=  roll timeStampForRightEdgeOf: self.
+ 		oldSpan := event duration.
+ 		newSpan := rightTime  - leftTime.
+ 		ratio := newSpan asFloat / oldSpan.
+ 		newSpan ~= oldSpan
+ 			ifTrue:
+ 				[baseline := event events first timeStamp.
+ 				event events do:
+ 					[:evt | evt timeStamp:
+ 						(baseline + (((evt timeStamp - baseline) * ratio)))].
+ 				event  startTime: event events first timeStamp.
+ 				event stopTime: event events last timeStamp.
+ 				roll pushChangesBackToEventTheatre]
+ 			ifFalse:
+ 				[^ self]]!

Item was added:
+ ----- Method: MouseEventSequenceMorph>>openExpandedView (in category 'menu') -----
+ openExpandedView
+ 	"Open an editor allowing the actual events constituting the receiver to be visualized and edited."
+ 
+ 	| anEditor roll |
+ 	anEditor := MouseEventEditor new.
+ 	(roll := self eventRoll) ifNil: [Beeper beep.  ^ self flash].
+ 
+ 	anEditor initializeFor: self forEventRoll: roll.
+ 	anEditor bounds: roll eventTheatre contentArea bounds.
+ 	anEditor openInWorld!

Item was added:
+ ----- Method: MouseEventSequenceMorph>>openExpandedView: (in category 'menu') -----
+ openExpandedView: evt
+ 	"The user double-clicked on me; open a derivative editor for my interior,  However, for the double-click is disabled and we require the user to pop up the halo menu for me to get at the expanded-view commands.  Thus, for the moment, this method has no senders."
+ 
+ 	| aMorph anEditor roll |
+ 
+ 	 (roll := self eventRoll) ifNil: [^ Beeper beep].
+ 
+ 	evt shiftPressed ifFalse: 
+ 		[anEditor := MouseEventEditor new.
+ 		anEditor initializeFor: self forEventRoll: roll.
+ 		anEditor bounds: roll eventTheatre contentArea bounds.
+ 		^ anEditor openInWorld].
+ 
+ 	aMorph := TextualEventSequenceDisplayer new.
+ 	aMorph mouseEventSequenceMorph: self.
+ 	aMorph openInHand!

Item was added:
+ ----- Method: MouseEventSequenceMorph>>openTextualView (in category 'menu') -----
+ openTextualView
+ 	"Open a textual view of the events in the receiver."
+ 
+ 	| aMorph |
+ 	aMorph := TextualEventSequenceDisplayer new.
+ 	aMorph mouseEventSequenceMorph: self.
+ 	aMorph openInHand!

Item was added:
+ ----- Method: MouseEventSequenceMorph>>putEventsOnto: (in category 'processing') -----
+ putEventsOnto: aStream
+ 	"Write all of the events represented by the receiver in its current state onto the given stream."
+ 
+ 	| newEvent aTimeStamp itsStartTime |
+ 	itsStartTime := event events first timeStamp.
+ 	event events do:
+ 		[:evt |
+ 			newEvent := evt veryDeepCopy.
+ 			aTimeStamp := self eventRoll timeStampForCurrentPositionOf: self.
+ 			newEvent timeStamp: (aTimeStamp + (evt timeStamp - itsStartTime)).
+ 			aStream nextPut: newEvent]!

Item was added:
+ EllipseMorph subclass: #MouseEventToken
+ 	instanceVariableNames: 'index event'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !MouseEventToken commentStamp: 'sw 12/21/2006 22:42' prior: 0!
+ A token representing a single mouse event.  Used in mouse-event sequence editors.!

Item was added:
+ ----- Method: MouseEventToken>>index:event: (in category 'initialization') -----
+ index: anIndex event: anEvent
+ 	"Given the receiver's index and event, initialize it."
+ 
+ 	| aStringMorph |
+ 	index := anIndex.
+ 	event := anEvent.
+ 	self borderWidth: 0.
+ 	self beSticky.
+ 	aStringMorph := StringMorph contents: anIndex printString font: (StrikeFont familyName: 'BitstreamVeraSans' size: 9).
+ 	self extent: (aStringMorph width + 4)  @ (aStringMorph height + 4).
+ 	self addMorphCentered: aStringMorph
+ 
+ !

Item was added:
+ MouseSensorMorph subclass: #MouseOverMorph
+ 	instanceVariableNames: 'mouseEnterSelector mouseMoveSelector mouseLeaveSelector'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Components'!

Item was added:
+ ----- Method: MouseOverMorph>>handlesMouseOver: (in category 'event handling') -----
+ handlesMouseOver: evt 
+ 	^model notNil!

Item was added:
+ ----- Method: MouseOverMorph>>mouseEnter: (in category 'event handling') -----
+ mouseEnter: event
+ 	"Relay a mouseEnter event to my model."
+ 
+ 	mouseEnterSelector ifNotNil:
+ 		[mouseEnterSelector numArgs = 0
+ 			ifTrue: [^ model perform: mouseEnterSelector].
+ 		mouseEnterSelector numArgs = 1
+ 			ifTrue: [^ model perform: mouseEnterSelector with: event].
+ 		mouseEnterSelector numArgs = 2
+ 			ifTrue: [^ model perform: mouseEnterSelector with: true with: event].
+ 		^ self error: 'mouseEnterselector must take 0, 1, or 2 arguments']!

Item was added:
+ ----- Method: MouseOverMorph>>mouseLeave: (in category 'event handling') -----
+ mouseLeave: event
+ 	"Relay a mouseLeave event to my model."
+ 
+ 	mouseLeaveSelector ifNotNil:
+ 		[mouseLeaveSelector numArgs = 0
+ 			ifTrue: [^ model perform: mouseLeaveSelector].
+ 		mouseLeaveSelector numArgs = 1
+ 			ifTrue: [^ model perform: mouseLeaveSelector with: event].
+ 		^ self error: 'mouseLeaveSelector must take 0, or 1 argument'].
+ 
+ 	mouseEnterSelector ifNotNil:
+ 		["Or send mouseEnter: false..."
+ 		mouseEnterSelector numArgs = 2
+ 			ifTrue: [^ model perform: mouseEnterSelector with: false with: event].
+ 		^ self error: 'mouseEnterSelector must take 2 arguments']!

Item was added:
+ ----- Method: MouseOverMorph>>mouseMove: (in category 'event handling') -----
+ mouseMove: event
+ 	"Relay a mouseMove event to my model."
+ 
+ 	mouseMoveSelector ifNotNil:
+ 		[mouseMoveSelector numArgs = 0
+ 			ifTrue: [^ model perform: mouseMoveSelector].
+ 		mouseMoveSelector numArgs = 1
+ 			ifTrue: [^ model perform: mouseMoveSelector with: event cursorPoint].
+ 		mouseMoveSelector numArgs = 2
+ 			ifTrue: [^ model perform: mouseMoveSelector with: event cursorPoint with: event].
+ 		^ self error: 'mouseMoveSelector must take 0, 1, or 2 arguments']!

Item was added:
+ Component subclass: #MouseSensorMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Components'!

Item was added:
+ ----- Method: MouseSensorMorph class>>includeInNewMorphMenu (in category 'as yet unclassified') -----
+ includeInNewMorphMenu
+ 	"Only include instances of subclasses of me"
+ 	^ self ~~ MouseSensorMorph!

Item was added:
+ ----- Method: MouseSensorMorph class>>isSystemDefined (in category 'as yet unclassified') -----
+ isSystemDefined
+ 	^ true
+ !

Item was added:
+ ----- Method: MouseSensorMorph>>fullDrawOn: (in category 'drawing') -----
+ fullDrawOn: aCanvas
+ 	self installed ifFalse: [aCanvas drawMorph: self]!

Item was added:
+ ----- Method: MouseSensorMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	super initialize.
+ 	self bounds: (0 at 0 extent: 20 at 20)!

Item was added:
+ ----- Method: MouseSensorMorph>>installed (in category 'testing') -----
+ installed
+ 
+ self halt: 'under construction'
+ "
+ 	^ (owner ~~ nil) and: [owner isWorldOrHandMorph not]
+ "!

Item was added:
+ EllipseMorph subclass: #MovingEyeMorph
+ 	instanceVariableNames: 'inner iris'
+ 	classVariableNames: 'IrisSize'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Demo'!

Item was added:
+ ----- Method: MovingEyeMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName:	'MovingEye' translatedNoop
+ 		categories:		{'Just for Fun' translatedNoop}
+ 		documentation:	'An eye which follows the cursor' translatedNoop!

Item was added:
+ ----- Method: MovingEyeMorph class>>initialize (in category 'class initialization') -----
+ initialize
+ "
+ 	MovingEyeMorph initialize
+ "
+ 	IrisSize _ (0.42 at 0.50).!

Item was added:
+ ----- Method: MovingEyeMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ "answer the default color/fill style for the receiver"
+ 	^ Color black!

Item was added:
+ ----- Method: MovingEyeMorph>>extent: (in category 'geometry') -----
+ extent: aPoint
+ 
+ 	super extent: aPoint.
+ 	inner extent: (self extent * ((1.0 at 1.0)-IrisSize)) asIntegerPoint.
+ 	iris extent: (self extent * IrisSize) asIntegerPoint.
+ 	inner position: (self center - (inner extent // 2)) asIntegerPoint.
+ !

Item was added:
+ ----- Method: MovingEyeMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	inner _ EllipseMorph new.
+ 	inner color: self color.
+ 	inner extent: (self extent * (1.0 @ 1.0 - IrisSize)) asIntegerPoint.
+ 	inner borderColor: self color.
+ 	inner borderWidth: 0.
+ ""
+ 	iris _ EllipseMorph new.
+ 	iris color: Color white.
+ 	iris extent: (self extent * IrisSize) asIntegerPoint.
+ ""
+ 	self addMorphCentered: inner.
+ 	inner addMorphCentered: iris.
+ ""
+ 	self extent: 26 @ 33!

Item was added:
+ ----- Method: MovingEyeMorph>>irisPos: (in category 'as yet unclassified') -----
+ irisPos: cp
+ 
+ 	| a b theta x y |
+ 	theta _ (cp - self center) theta.
+ 	a _ inner width // 2.
+ 	b _ inner height // 2.
+ 	x _ a * (theta cos).
+ 	y _ b * (theta sin).
+ 	iris position: ((x at y) asIntegerPoint) + self center - (iris extent // 2).!

Item was added:
+ ----- Method: MovingEyeMorph>>step (in category 'stepping and presenter') -----
+ step
+ 	| cp |
+ 	cp _ self globalPointToLocal: World primaryHand position.
+ 	(inner containsPoint: cp)
+ 		ifTrue: [iris position: (cp - (iris extent // 2))]
+ 		ifFalse: [self irisPos: cp].
+ 	self changed "cover up gribblies if embedded in Flash"!

Item was added:
+ ----- Method: MovingEyeMorph>>stepTime (in category 'testing') -----
+ stepTime
+ 
+ 	^ 100.!

Item was added:
+ HttpUrl subclass: #MswUrl
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-Url'!
+ 
+ !MswUrl commentStamp: '<historical>' prior: 0!
+ (out of date class....)!

Item was added:
+ ----- Method: MswUrl>>httpUrlOfServer (in category 'misc') -----
+ httpUrlOfServer
+ 	"return the HTTP address to make queries to"	
+ 	#XXX.  "should come up with a better name for this when I'm less tired"
+ 	^HttpUrl schemeName: 'http'  authority: authority  path: path  query: nil.!

Item was added:
+ ----- Method: MswUrl>>query (in category 'access') -----
+ query
+ 	"return the query.  There is never a MuSwiki URL without a query; the query defaults to 'top' if none is explicitly specified"
+ 	| q |
+ 	q _ super query.
+ 	q isNil ifTrue: [ q _ 'top' ].
+ 	^q!

Item was added:
+ ----- Method: MultiByteBinaryOrTextStream>>basicUpToEnd (in category '*Etoys-Squeakland-public') -----
+ basicUpToEnd
+ 
+ 	^ collection copyFrom: position+1 to: self size.!

Item was added:
+ ----- Method: MultiByteBinaryOrTextStream>>rawContents (in category '*Etoys-Squeakland-public') -----
+ rawContents
+ 
+ 	super contents.
+ !

Item was added:
+ MultiCharacterScanner subclass: #MultiCanvasCharacterScanner
+ 	instanceVariableNames: 'canvas fillBlt foregroundColor runX lineY'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-Scanning'!

Item was added:
+ ----- Method: MultiCanvasCharacterScanner>>canvas: (in category 'accessing') -----
+ canvas: aCanvas
+ 	"set the canvas to draw on"
+ 	canvas ifNotNil: [ self inform: 'initializing twice!!' ].
+ 	canvas _ aCanvas!

Item was added:
+ ----- Method: MultiCanvasCharacterScanner>>cr (in category 'stop conditions') -----
+ cr
+ 	"When a carriage return is encountered, simply increment the pointer 
+ 	into the paragraph."
+ 
+ 	lastIndex_ lastIndex + 1.
+ 	^false!

Item was added:
+ ----- Method: MultiCanvasCharacterScanner>>crossedX (in category 'stop conditions') -----
+ crossedX
+ 	"This condition will sometimes be reached 'legally' during display, when, 
+ 	for instance the space that caused the line to wrap actually extends over 
+ 	the right boundary. This character is allowed to display, even though it 
+ 	is technically outside or straddling the clipping ectangle since it is in 
+ 	the normal case not visible and is in any case appropriately clipped by 
+ 	the scanner."
+ 
+ 	"self fillLeading."
+ 	^ true !

Item was added:
+ ----- Method: MultiCanvasCharacterScanner>>displayLine:offset:leftInRun: (in category 'scanning') -----
+ displayLine: textLine  offset: offset  leftInRun: leftInRun
+ 	|  nowLeftInRun done startLoc startIndex stopCondition |
+ 	"largely copied from DisplayScanner's routine"
+ 
+ 	line _ textLine.
+ 	foregroundColor ifNil: [ foregroundColor _ Color black ].
+ 	leftMargin _ (line leftMarginForAlignment: alignment) + offset x.
+ 
+ 	rightMargin _ line rightMargin + offset x.
+ 	lineY _ line top + offset y.
+ 	lastIndex _ textLine first.
+ 	leftInRun <= 0
+ 		ifTrue: [self setStopConditions.  "also sets the font"
+ 				nowLeftInRun _ text runLengthFor: lastIndex]
+ 		ifFalse: [nowLeftInRun _ leftInRun].
+ 	runX _ destX _ leftMargin.
+ 
+ 	runStopIndex _ lastIndex + (nowLeftInRun - 1) min: line last.
+ 	spaceCount _ 0.
+ 	done _ false.
+ 
+ 	[done] whileFalse: [
+ 		"remember where this portion of the line starts"
+ 		startLoc _ destX at destY.
+ 		startIndex _ lastIndex.
+ 
+ 		"find the end of this portion of the line"
+ 		stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex
+ 						in: text string rightX: rightMargin stopConditions: stopConditions
+ 						kern: kern "displaying: false".
+ 
+ 		"display that portion of the line"
+ 		canvas drawString: text string
+ 			from: startIndex to: lastIndex
+ 			at: startLoc
+ 			font: font
+ 			color: foregroundColor.
+ 
+ 		"handle the stop condition"
+ 		done _ self perform: stopCondition
+ 	].
+ 
+ 	^runStopIndex - lastIndex!

Item was added:
+ ----- Method: MultiCanvasCharacterScanner>>doesDisplaying (in category 'private') -----
+ doesDisplaying
+ 	^false   "it doesn't do displaying using copyBits"!

Item was added:
+ ----- Method: MultiCanvasCharacterScanner>>endOfRun (in category 'stop conditions') -----
+ endOfRun
+ 	"The end of a run in the display case either means that there is actually 
+ 	a change in the style (run code) to be associated with the string or the 
+ 	end of this line has been reached."
+ 	| runLength |
+ 
+ 	lastIndex = line last ifTrue: [^true].
+ 	runX _ destX.
+ 	runLength _ text runLengthFor: (lastIndex _ lastIndex + 1).
+ 	runStopIndex _ lastIndex + (runLength - 1) min: line last.
+ 	self setStopConditions.
+ 	^ false!

Item was added:
+ ----- Method: MultiCanvasCharacterScanner>>paddedSpace (in category 'stop conditions') -----
+ paddedSpace
+ 	"Each space is a stop condition when the alignment is right justified. 
+ 	Padding must be added to the base width of the space according to 
+ 	which space in the line this space is and according to the amount of 
+ 	space that remained at the end of the line when it was composed."
+ 
+ 	destX _ destX + spaceWidth + (line justifiedPadFor: spaceCount).
+ 
+ 	lastIndex _ lastIndex + 1.
+ 	^ false!

Item was added:
+ ----- Method: MultiCanvasCharacterScanner>>setFont (in category 'private') -----
+ setFont
+ 	foregroundColor ifNil: [foregroundColor _ Color black].
+ 	super setFont.
+ 	baselineY _ lineY + line baseline.
+ 	destY _ baselineY - font ascent.!

Item was added:
+ ----- Method: MultiCanvasCharacterScanner>>setStopConditions (in category 'stop conditions') -----
+ setStopConditions
+ 	"Set the font and the stop conditions for the current run."
+ 	
+ 	self setFont.
+ 	self setConditionArray: (textStyle alignment = Justified ifTrue: [#paddedSpace]).
+ !

Item was added:
+ ----- Method: MultiCanvasCharacterScanner>>tab (in category 'stop conditions') -----
+ tab
+ 
+ 	destX _ (alignment == Justified and: [self leadingTab not])
+ 		ifTrue:		"imbedded tabs in justified text are weird"
+ 			[destX + (textStyle tabWidth - (line justifiedTabDeltaFor: spaceCount)) max: destX]
+ 		ifFalse: 
+ 			[textStyle nextTabXFrom: destX
+ 				leftMargin: leftMargin
+ 				rightMargin: rightMargin].
+ 
+ 	lastIndex _ lastIndex + 1.
+ 	^ false!

Item was added:
+ ----- Method: MultiCanvasCharacterScanner>>textColor: (in category 'private') -----
+ textColor: color
+ 	foregroundColor _ color!

Item was added:
+ MultiCharacterScanner subclass: #MultiCharacterBlockScanner
+ 	instanceVariableNames: 'characterPoint characterIndex lastCharacter lastCharacterExtent lastSpaceOrTabExtent nextLeftMargin specialWidth'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-Scanning'!

Item was added:
+ ----- Method: MultiCharacterBlockScanner>>buildCharacterBlockIn: (in category 'private') -----
+ buildCharacterBlockIn: para
+ 	| lineIndex runLength lineStop done stopCondition |
+ 	"handle nullText"
+ 	(para numberOfLines = 0 or: [text size = 0])
+ 		ifTrue:	[^ CharacterBlock new stringIndex: 1  "like being off end of string"
+ 					text: para text
+ 					topLeft: (para leftMarginForDisplayForLine: 1 alignment: (alignment ifNil:[textStyle alignment]))
+ 								@ para compositionRectangle top
+ 					extent: 0 @ textStyle lineGrid].
+ 	"find the line"
+ 	lineIndex _ para lineIndexOfTop: characterPoint y.
+ 	destY _ para topAtLineIndex: lineIndex.
+ 	line _ para lines at: lineIndex.
+ 	rightMargin _ para rightMarginForDisplay.
+ 
+ 	(lineIndex = para numberOfLines and:
+ 		[(destY + line lineHeight) < characterPoint y])
+ 			ifTrue:	["if beyond lastLine, force search to last character"
+ 					self characterPointSetX: rightMargin]
+ 			ifFalse:	[characterPoint y < (para compositionRectangle) top
+ 						ifTrue: ["force search to first line"
+ 								characterPoint _ (para compositionRectangle) topLeft].
+ 					characterPoint x > rightMargin
+ 						ifTrue:	[self characterPointSetX: rightMargin]].
+ 	destX _ (leftMargin _ para leftMarginForDisplayForLine: lineIndex alignment: (alignment ifNil:[textStyle alignment])).
+ 	nextLeftMargin_ para leftMarginForDisplayForLine: lineIndex+1 alignment: (alignment ifNil:[textStyle alignment]).
+ 	lastIndex _ line first.
+ 
+ 	self setStopConditions.		"also sets font"
+ 	runLength _ (text runLengthFor: line first).
+ 	characterIndex == nil
+ 		ifTrue:	[lineStop _ line last  "characterBlockAtPoint"]
+ 		ifFalse:	[lineStop _ characterIndex  "characterBlockForIndex"].
+ 	(runStopIndex _ lastIndex + (runLength - 1)) > lineStop
+ 		ifTrue:	[runStopIndex _ lineStop].
+ 	lastCharacterExtent _ 0 @ line lineHeight.
+ 	spaceCount _ 0. done  _ false.
+ 	self handleIndentation.
+ 
+ 	[done]
+ 	whileFalse:
+ 	[stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex
+ 			in: text string rightX: characterPoint x
+ 			stopConditions: stopConditions kern: kern.
+ 
+ 	"see setStopConditions for stopping conditions for character block 	operations."
+ 	self lastCharacterExtentSetX: (font widthOf: (text at: lastIndex)).
+ 	(self perform: stopCondition) ifTrue:
+ 		[characterIndex == nil
+ 			ifTrue: ["characterBlockAtPoint"
+ 					^ CharacterBlock new stringIndex: lastIndex text: text
+ 						topLeft: characterPoint + (font descentKern @ 0)
+ 						extent: lastCharacterExtent]
+ 			ifFalse: ["characterBlockForIndex"
+ 					^ CharacterBlock new stringIndex: lastIndex text: text
+ 						topLeft: characterPoint + ((font descentKern) - kern @ 0)
+ 						extent: lastCharacterExtent]]]!

Item was added:
+ ----- Method: MultiCharacterBlockScanner>>characterBlockAtPoint:in: (in category 'scanning') -----
+ characterBlockAtPoint: aPoint in: aParagraph
+ 	"Answer a CharacterBlock for character in aParagraph at point aPoint. It 
+ 	is assumed that aPoint has been transformed into coordinates appropriate 
+ 	to the text's destination form rectangle and the composition rectangle."
+ 
+ 	self initializeFromParagraph: aParagraph clippedBy: aParagraph clippingRectangle.
+ 	characterPoint _ aPoint.
+ 	^self buildCharacterBlockIn: aParagraph!

Item was added:
+ ----- Method: MultiCharacterBlockScanner>>characterBlockAtPoint:index:in: (in category 'scanning') -----
+ characterBlockAtPoint: aPoint index: index in: textLine
+ 	"This method is the Morphic characterBlock finder.  It combines
+ 	MVC's characterBlockAtPoint:, -ForIndex:, and buildCharcterBlock:in:"
+ 	| runLength lineStop done stopCondition |
+ 	line := textLine.
+ 	rightMargin := line rightMargin.
+ 	lastIndex := line first.
+ 	self setStopConditions.		"also sets font"
+ 	characterIndex := index.  " == nil means scanning for point"
+ 	characterPoint := aPoint.
+ 	(characterPoint isNil or: [characterPoint y > line bottom])
+ 		ifTrue: [characterPoint := line bottomRight].
+ 	(text isEmpty or: [(characterPoint y < line top or: [characterPoint x < line left])
+ 				or: [characterIndex notNil and: [characterIndex < line first]]])
+ 		ifTrue:	[^ (CharacterBlock new stringIndex: line first text: text
+ 					topLeft: line leftMargin at line top extent: 0 @ textStyle lineGrid)
+ 					textLine: line].
+ 	destX := leftMargin := line leftMarginForAlignment: alignment.
+ 	destY := line top.
+ 	runLength := text runLengthFor: line first.
+ 	characterIndex
+ 		ifNotNil:	[lineStop := characterIndex  "scanning for index"]
+ 		ifNil:	[lineStop := line last  "scanning for point"].
+ 	runStopIndex := lastIndex + (runLength - 1) min: lineStop.
+ 	lastCharacterExtent := 0 @ line lineHeight.
+ 	spaceCount := 0.
+ 
+ 	done  := false.
+ 	[done] whileFalse:
+ 		[stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex
+ 			in: text string rightX: characterPoint x
+ 			stopConditions: stopConditions kern: kern.
+ 		"see setStopConditions for stopping conditions for character block 	operations."
+ 		self lastCharacterExtentSetX: (specialWidth
+ 			ifNil: [font widthOf: (text at: lastIndex)]
+ 			ifNotNil: [specialWidth]).
+ 		(self perform: stopCondition) ifTrue:
+ 			[characterIndex
+ 				ifNil: [
+ 					"Result for characterBlockAtPoint: "
+ 					(stopCondition ~~ #cr and: [ lastIndex == line last
+ 						and: [ aPoint x > ((characterPoint x) + (lastCharacterExtent x / 2)) ]])
+ 							ifTrue: [ "Correct for right half of last character in line"
+ 								^ (CharacterBlock new stringIndex: lastIndex + 1
+ 										text: text
+ 										topLeft: characterPoint + (lastCharacterExtent x @ 0) + (font descentKern @ 0)
+ 										extent:  0 @ lastCharacterExtent y)
+ 									textLine: line ].
+ 						^ (CharacterBlock new stringIndex: lastIndex
+ 							text: text topLeft: characterPoint + (font descentKern @ 0)
+ 							extent: lastCharacterExtent - (font baseKern @ 0))
+ 									textLine: line]
+ 				ifNotNil: ["Result for characterBlockForIndex: "
+ 						^ (CharacterBlock new stringIndex: characterIndex
+ 							text: text topLeft: characterPoint + ((font descentKern) - kern @ 0)
+ 							extent: lastCharacterExtent)
+ 									textLine: line]]]!

Item was added:
+ ----- Method: MultiCharacterBlockScanner>>characterBlockForIndex:in: (in category 'scanning') -----
+ characterBlockForIndex: targetIndex in: aParagraph 
+ 	"Answer a CharacterBlock for character in aParagraph at targetIndex. The 
+ 	coordinates in the CharacterBlock will be appropriate to the intersection 
+ 	of the destination form rectangle and the composition rectangle."
+ 
+ 	self 
+ 		initializeFromParagraph: aParagraph 
+ 		clippedBy: aParagraph clippingRectangle.
+ 	characterIndex _ targetIndex.
+ 	characterPoint _ 
+ 		aParagraph rightMarginForDisplay @ 
+ 			(aParagraph topAtLineIndex: 
+ 				(aParagraph lineIndexOfCharacterIndex: characterIndex)).
+ 	^self buildCharacterBlockIn: aParagraph!

Item was added:
+ ----- Method: MultiCharacterBlockScanner>>characterPointSetX: (in category 'private') -----
+ characterPointSetX: xVal
+ 	characterPoint _ xVal @ characterPoint y!

Item was added:
+ ----- Method: MultiCharacterBlockScanner>>cr (in category 'stop conditions') -----
+ cr 
+ 	"Answer a CharacterBlock that specifies the current location of the mouse 
+ 	relative to a carriage return stop condition that has just been 
+ 	encountered. The ParagraphEditor convention is to denote selections by 
+ 	CharacterBlocks, sometimes including the carriage return (cursor is at 
+ 	the end) and sometimes not (cursor is in the middle of the text)."
+ 
+ 	((characterIndex ~= nil
+ 		and: [characterIndex > text size])
+ 			or: [(line last = text size)
+ 				and: [(destY + line lineHeight) < characterPoint y]])
+ 		ifTrue:	["When off end of string, give data for next character"
+ 				destY _ destY +  line lineHeight.
+ 				baselineY _ line lineHeight.
+ 				lastCharacter _ nil.
+ 				characterPoint _ (nextLeftMargin ifNil: [leftMargin]) @ destY.
+ 				lastIndex _ lastIndex + 1.
+ 				self lastCharacterExtentSetX: 0.
+ 				^ true].
+ 		lastCharacter _ CR.
+ 		characterPoint _ destX @ destY.
+ 		self lastCharacterExtentSetX: rightMargin - destX.
+ 		^true!

Item was added:
+ ----- Method: MultiCharacterBlockScanner>>crossedX (in category 'stop conditions') -----
+ crossedX
+ 	"Text display has wrapping. The scanner just found a character past the x 
+ 	location of the cursor. We know that the cursor is pointing at a character 
+ 	or before one."
+ 
+ 	| leadingTab currentX |
+ 	characterIndex == nil ifFalse: [
+ 		"If the last character of the last line is a space,
+ 		and it crosses the right margin, then locating
+ 		the character block after it is impossible without this hack."
+ 		characterIndex > text size ifTrue: [
+ 			lastIndex _ characterIndex.
+ 			characterPoint _ (nextLeftMargin ifNil: [leftMargin]) @ (destY + line lineHeight).
+ 			^true]].
+ 	characterPoint x <= (destX + (lastCharacterExtent x // 2))
+ 		ifTrue:	[lastCharacter _ (text at: lastIndex).
+ 				characterPoint _ destX @ destY.
+ 				^true].
+ 	lastIndex >= line last 
+ 		ifTrue:	[lastCharacter _ (text at: line last).
+ 				characterPoint _ destX @ destY.
+ 				^true].
+ 
+ 	"Pointing past middle of a character, return the next character."
+ 	lastIndex _ lastIndex + 1.
+ 	lastCharacter _ text at: lastIndex.
+ 	currentX _ destX + lastCharacterExtent x + kern.
+ 	self lastCharacterExtentSetX: (font widthOf: lastCharacter).
+ 	characterPoint _ currentX @ destY.
+ 	lastCharacter = Space ifFalse: [^ true].
+ 
+ 	"Yukky if next character is space or tab."
+ 	alignment = Justified ifTrue:
+ 		[self lastCharacterExtentSetX:
+ 			(lastCharacterExtent x + 	(line justifiedPadFor: (spaceCount + 1))).
+ 		^ true].
+ 
+ 	true ifTrue: [^ true].
+ 	"NOTE:  I find no value to the following code, and so have defeated it - DI"
+ 
+ 	"See tabForDisplay for illumination on the following awfulness."
+ 	leadingTab _ true.
+ 	line first to: lastIndex - 1 do:
+ 		[:index | (text at: index) ~= Tab ifTrue: [leadingTab _ false]].
+ 	(alignment ~= Justified or: [leadingTab])
+ 		ifTrue:	[self lastCharacterExtentSetX: (textStyle nextTabXFrom: currentX
+ 					leftMargin: leftMargin rightMargin: rightMargin) -
+ 						currentX]
+ 		ifFalse:	[self lastCharacterExtentSetX:  (((currentX + (textStyle tabWidth -
+ 						(line justifiedTabDeltaFor: spaceCount))) -
+ 							currentX) max: 0)].
+ 	^ true!

Item was added:
+ ----- Method: MultiCharacterBlockScanner>>endOfRun (in category 'stop conditions') -----
+ endOfRun
+ 	"Before arriving at the cursor location, the selection has encountered an 
+ 	end of run. Answer false if the selection continues, true otherwise. Set 
+ 	up indexes for building the appropriate CharacterBlock."
+ 
+ 	| runLength lineStop |
+ 	(((characterIndex ~~ nil and:
+ 		[runStopIndex < characterIndex and: [runStopIndex < text size]])
+ 			or:	[characterIndex == nil and: [lastIndex < line last]]) or: [
+ 				((lastIndex < line last)
+ 				and: [((text at: lastIndex) leadingChar ~= (text at: lastIndex+1) leadingChar)
+ 					and: [lastIndex ~= characterIndex]])])
+ 		ifTrue:	["We're really at the end of a real run."
+ 				runLength _ (text runLengthFor: (lastIndex _ lastIndex + 1)).
+ 				characterIndex ~~ nil
+ 					ifTrue:	[lineStop _ characterIndex	"scanning for index"]
+ 					ifFalse:	[lineStop _ line last			"scanning for point"].
+ 				(runStopIndex _ lastIndex + (runLength - 1)) > lineStop
+ 					ifTrue: 	[runStopIndex _ lineStop].
+ 				self setStopConditions.
+ 				^false].
+ 
+ 	lastCharacter _ text at: lastIndex.
+ 	characterPoint _ destX @ destY.
+ 	((lastCharacter = Space and: [alignment = Justified])
+ 		or: [lastCharacter = Tab and: [lastSpaceOrTabExtent notNil]])
+ 		ifTrue: [lastCharacterExtent _ lastSpaceOrTabExtent].
+ 	characterIndex ~~ nil
+ 		ifTrue:	["If scanning for an index and we've stopped on that index,
+ 				then we back destX off by the width of the character stopped on
+ 				(it will be pointing at the right side of the character) and return"
+ 				runStopIndex = characterIndex
+ 					ifTrue:	[self characterPointSetX: destX - lastCharacterExtent x.
+ 							^true].
+ 				"Otherwise the requested index was greater than the length of the
+ 				string.  Return string size + 1 as index, indicate further that off the
+ 				string by setting character to nil and the extent to 0."
+ 				lastIndex _  lastIndex + 1.
+ 				lastCharacter _ nil.
+ 				self lastCharacterExtentSetX: 0.
+ 				^true].
+ 
+ 	"Scanning for a point and either off the end of the line or off the end of the string."
+ 	runStopIndex = text size
+ 		ifTrue:	["off end of string"
+ 				lastIndex _  lastIndex + 1.
+ 				lastCharacter _ nil.
+ 				self lastCharacterExtentSetX: 0.
+ 				^true].
+ 	"just off end of line without crossing x"
+ 	lastIndex _ lastIndex + 1.
+ 	^true!

Item was added:
+ ----- Method: MultiCharacterBlockScanner>>indentationLevel: (in category 'scanning') -----
+ indentationLevel: anInteger
+ 	super indentationLevel: anInteger.
+ 	nextLeftMargin _ leftMargin.
+ 	indentationLevel timesRepeat: [
+ 		nextLeftMargin _ textStyle nextTabXFrom: nextLeftMargin
+ 					leftMargin: leftMargin
+ 					rightMargin: rightMargin]!

Item was added:
+ ----- Method: MultiCharacterBlockScanner>>lastCharacterExtentSetX: (in category 'private') -----
+ lastCharacterExtentSetX: xVal
+ 	lastCharacterExtent _ xVal @ lastCharacterExtent y!

Item was added:
+ ----- Method: MultiCharacterBlockScanner>>lastSpaceOrTabExtentSetX: (in category 'private') -----
+ lastSpaceOrTabExtentSetX: xVal
+ 	lastSpaceOrTabExtent _ xVal @ lastSpaceOrTabExtent y!

Item was added:
+ ----- Method: MultiCharacterBlockScanner>>paddedSpace (in category 'stop conditions') -----
+ paddedSpace
+ 	"When the line is justified, the spaces will not be the same as the font's 
+ 	space character. A padding of extra space must be considered in trying 
+ 	to find which character the cursor is pointing at. Answer whether the 
+ 	scanning has crossed the cursor."
+ 
+ 	| pad |
+ 	pad _ 0.
+ 	spaceCount _ spaceCount + 1.
+ 	pad _ line justifiedPadFor: spaceCount.
+ 	lastSpaceOrTabExtent _ lastCharacterExtent copy.
+ 	self lastSpaceOrTabExtentSetX:  spaceWidth + pad.
+ 	(destX + lastSpaceOrTabExtent x)  >= characterPoint x
+ 		ifTrue: [lastCharacterExtent _ lastSpaceOrTabExtent copy.
+ 				^self crossedX].
+ 	lastIndex _ lastIndex + 1.
+ 	destX _ destX + lastSpaceOrTabExtent x.
+ 	^ false
+ !

Item was added:
+ ----- Method: MultiCharacterBlockScanner>>placeEmbeddedObject: (in category 'scanning') -----
+ placeEmbeddedObject: anchoredMorph
+ 	"Workaround: The following should really use #textAnchorType"
+ 	anchoredMorph relativeTextAnchorPosition ifNotNil:[^true].
+ 	(super placeEmbeddedObject: anchoredMorph) ifFalse: [^ false].
+ 	specialWidth _ anchoredMorph width.
+ 	^ true!

Item was added:
+ ----- Method: MultiCharacterBlockScanner>>scanMultiCharactersCombiningFrom:to:in:rightX:stopConditions:kern: (in category 'scanning') -----
+ scanMultiCharactersCombiningFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta
+ 
+ 	| encoding f nextDestX maxAscii startEncoding char charValue |
+ 	lastIndex _ startIndex.
+ 	lastIndex > stopIndex ifTrue: [lastIndex _ stopIndex. ^ stops at: EndOfRun].
+ 	startEncoding _ (sourceString at: startIndex) leadingChar.
+ 	font ifNil: [font _ (TextConstants at: #DefaultMultiStyle) fontArray at: 1].
+ 	((font isMemberOf: StrikeFontSet) or: [font isKindOf: TTCFontSet]) ifTrue: [
+ 		[f _ font fontArray at: startEncoding + 1]
+ 			on: Exception do: [:ex | f _ font fontArray at: 1].
+ 		f ifNil: [ f _ font fontArray at: 1].
+ 		maxAscii _ f maxAscii.
+ 		spaceWidth _ f widthOf: Space.
+ 	] ifFalse: [
+ 		maxAscii _ font maxAscii.
+ 	].
+ 
+ 	[lastIndex <= stopIndex] whileTrue: [
+ 		encoding _ (sourceString at: lastIndex) leadingChar.
+ 		encoding ~= startEncoding ifTrue: [lastIndex _ lastIndex - 1. ^ stops at: EndOfRun].
+ 		char _ (sourceString at: lastIndex).
+ 		charValue _ char charCode.
+ 		charValue > maxAscii ifTrue: [charValue _ maxAscii].
+ 		(encoding = 0 and: [(stopConditions at: charValue + 1) ~~ nil]) ifTrue: [
+ 			^ stops at: charValue + 1
+ 		].
+ 		nextDestX _ destX + (self widthOf: char inFont: font).
+ 		nextDestX > rightX ifTrue: [^ stops at: CrossedX].
+ 		destX _ nextDestX + kernDelta.
+ 		lastIndex _ lastIndex + 1.
+ 	].
+ 	lastIndex _ stopIndex.
+ 	^ stops at: EndOfRun!

Item was added:
+ ----- Method: MultiCharacterBlockScanner>>setFont (in category 'stop conditions') -----
+ setFont
+ 	specialWidth _ nil.
+ 	super setFont!

Item was added:
+ ----- Method: MultiCharacterBlockScanner>>setStopConditions (in category 'stop conditions') -----
+ setStopConditions
+ 	"Set the font and the stop conditions for the current run."
+ 	
+ 	self setFont.
+ 	self setConditionArray: (alignment = Justified ifTrue: [#paddedSpace]).
+ !

Item was added:
+ ----- Method: MultiCharacterBlockScanner>>tab (in category 'stop conditions') -----
+ tab
+ 	| currentX |
+ 	currentX _ (alignment == Justified and: [self leadingTab not])
+ 		ifTrue:		"imbedded tabs in justified text are weird"
+ 			[destX + (textStyle tabWidth - (line justifiedTabDeltaFor: spaceCount)) max: destX]
+ 		ifFalse:
+ 			[textStyle
+ 				nextTabXFrom: destX
+ 				leftMargin: leftMargin
+ 				rightMargin: rightMargin].
+ 	lastSpaceOrTabExtent _ lastCharacterExtent copy.
+ 	self lastSpaceOrTabExtentSetX: (currentX - destX max: 0).
+ 	currentX >= characterPoint x
+ 		ifTrue: 
+ 			[lastCharacterExtent _ lastSpaceOrTabExtent copy.
+ 			^ self crossedX].
+ 	destX _ currentX.
+ 	lastIndex _ lastIndex + 1.
+ 	^false!

Item was added:
+ Object subclass: #MultiCharacterScanner
+ 	instanceVariableNames: 'destX lastIndex xTable destY stopConditions text textStyle alignment leftMargin rightMargin font line runStopIndex spaceCount spaceWidth emphasisCode kern indentationLevel wantsColumnBreaks presentation presentationLine numOfComposition baselineY firstDestX'
+ 	classVariableNames: 'DefaultStopConditions NilCondition PaddedSpaceCondition SpaceCondition'
+ 	poolDictionaries: 'TextConstants'
+ 	category: 'Etoys-Squeakland-Multilingual-Scanning'!

Item was added:
+ ----- Method: MultiCharacterScanner class>>initialize (in category 'class initialization') -----
+ initialize
+ "
+ 	MultiCharacterScanner initialize
+ "
+ 	| a |
+ 	a _ Array new: 258.
+ 	a at: 1 + 1 put: #embeddedObject.
+ 	a at: Tab asciiValue + 1 put: #tab.
+ 	a at: CR asciiValue + 1 put: #cr.
+ 	a at: EndOfRun put: #endOfRun.
+ 	a at: CrossedX put: #crossedX.
+ 	NilCondition _ a copy.
+ 	DefaultStopConditions _ a copy.
+ 
+ 	PaddedSpaceCondition _ a copy.
+ 	PaddedSpaceCondition at: Space asciiValue + 1 put: #paddedSpace.
+ 	
+ 	SpaceCondition _ a copy.
+ 	SpaceCondition at: Space asciiValue + 1 put: #space.
+ !

Item was added:
+ ----- Method: MultiCharacterScanner>>addCharToPresentation: (in category 'multilingual scanning') -----
+ addCharToPresentation: char
+ 
+ !

Item was added:
+ ----- Method: MultiCharacterScanner>>addEmphasis: (in category 'private') -----
+ addEmphasis: code
+ 	"Set the bold-ital-under-strike emphasis."
+ 	emphasisCode _ emphasisCode bitOr: code!

Item was added:
+ ----- Method: MultiCharacterScanner>>addKern: (in category 'private') -----
+ addKern: kernDelta
+ 	"Set the current kern amount."
+ 	kern _ kern + kernDelta!

Item was added:
+ ----- Method: MultiCharacterScanner>>basicScanCharactersFrom:to:in:rightX:stopConditions:kern: (in category 'scanning') -----
+ basicScanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta
+ 	"Primitive. This is the inner loop of text display--but see 
+ 	scanCharactersFrom: to:rightX: which would get the string, 
+ 	stopConditions and displaying from the instance. March through source 
+ 	String from startIndex to stopIndex. If any character is flagged with a 
+ 	non-nil entry in stops, then return the corresponding value. Determine 
+ 	width of each character from xTable, indexed by map. 
+ 	If dextX would exceed rightX, then return stops at: 258. 
+ 	Advance destX by the width of the character. If stopIndex has been
+ 	reached, then return stops at: 257. Optional. 
+ 	See Object documentation whatIsAPrimitive."
+ 	| ascii nextDestX char |
+ 	<primitive: 103>
+ 	lastIndex _ startIndex.
+ 	[lastIndex <= stopIndex]
+ 		whileTrue: 
+ 			[char _ (sourceString at: lastIndex).
+ 			ascii _ char asciiValue + 1.
+ 			(stops at: ascii) == nil ifFalse: [^stops at: ascii].
+ 			"Note: The following is querying the font about the width
+ 			since the primitive may have failed due to a non-trivial
+ 			mapping of characters to glyphs or a non-existing xTable."
+ 			nextDestX _ destX + (font widthOf: char).
+ 			nextDestX > rightX ifTrue: [^stops at: CrossedX].
+ 			destX _ nextDestX + kernDelta.
+ 			lastIndex _ lastIndex + 1].
+ 	lastIndex _ stopIndex.
+ 	^stops at: EndOfRun!

Item was added:
+ ----- Method: MultiCharacterScanner>>columnBreak (in category 'scanning') -----
+ columnBreak
+ 
+ 	^true!

Item was added:
+ ----- Method: MultiCharacterScanner>>combinableChar:for: (in category 'scanner methods') -----
+ combinableChar: char for: prevEntity
+ 
+ !

Item was added:
+ ----- Method: MultiCharacterScanner>>embeddedObject (in category 'scanning') -----
+ embeddedObject
+ 	| savedIndex |
+ 	savedIndex _ lastIndex.
+ 	text attributesAt: lastIndex do:[:attr| 
+ 		attr anchoredMorph ifNotNil:[
+ 			"Following may look strange but logic gets reversed.
+ 			If the morph fits on this line we're not done (return false for true) 
+ 			and if the morph won't fit we're done (return true for false)"
+ 			(self placeEmbeddedObject: attr anchoredMorph) ifFalse:[^true]]].
+ 	lastIndex _ savedIndex + 1. "for multiple(!!) embedded morphs"
+ 	^false!

Item was added:
+ ----- Method: MultiCharacterScanner>>handleIndentation (in category 'scanning') -----
+ handleIndentation
+ 	self indentationLevel timesRepeat: [
+ 		self plainTab]!

Item was added:
+ ----- Method: MultiCharacterScanner>>indentationLevel (in category 'scanning') -----
+ indentationLevel
+ 	"return the number of tabs that are currently being placed at the beginning of each line"
+ 	^indentationLevel ifNil:[0]!

Item was added:
+ ----- Method: MultiCharacterScanner>>indentationLevel: (in category 'scanning') -----
+ indentationLevel: anInteger
+ 	"set the number of tabs to put at the beginning of each line"
+ 	indentationLevel _ anInteger!

Item was added:
+ ----- Method: MultiCharacterScanner>>initialize (in category 'initialize') -----
+ initialize
+ 	destX _ destY _ leftMargin _ 0.!

Item was added:
+ ----- Method: MultiCharacterScanner>>initializeFromParagraph:clippedBy: (in category 'private') -----
+ initializeFromParagraph: aParagraph clippedBy: clippingRectangle
+ 
+ 	text _ aParagraph text.
+ 	textStyle _ aParagraph textStyle. 
+ !

Item was added:
+ ----- Method: MultiCharacterScanner>>initializeStringMeasurer (in category 'initialize') -----
+ initializeStringMeasurer
+ 	stopConditions _ Array new: 258.
+ 	stopConditions at: CrossedX put: #crossedX.
+ 	stopConditions at: EndOfRun put: #endOfRun.
+ !

Item was added:
+ ----- Method: MultiCharacterScanner>>isBreakableAt:in:in: (in category 'scanner methods') -----
+ isBreakableAt: index in: sourceString in: encodingClass
+ 
+ 	^ encodingClass isBreakableAt: index in: sourceString.
+ !

Item was added:
+ ----- Method: MultiCharacterScanner>>leadingTab (in category 'scanning') -----
+ leadingTab
+ 	"return true if only tabs lie to the left"
+ 	line first to: lastIndex do:
+ 		[:i | (text at: i) == Tab ifFalse: [^ false]].
+ 	^ true!

Item was added:
+ ----- Method: MultiCharacterScanner>>measureString:inFont:from:to: (in category 'scanning') -----
+ measureString: aString inFont: aFont from: startIndex to: stopIndex
+ 	"WARNING: In order to use this method the receiver has to be set up using #initializeStringMeasurer"
+ 	destX _ destY _ lastIndex _ 0.
+ 	baselineY _ aFont ascent.
+ 	xTable _ aFont xTable.
+ 	font := aFont.  " added Dec 03, 2004 "
+ "	map _ aFont characterToGlyphMap."
+ 	self scanCharactersFrom: startIndex to: stopIndex in: aString rightX: 999999 stopConditions: stopConditions kern: 0.
+ 	^destX!

Item was added:
+ ----- Method: MultiCharacterScanner>>placeEmbeddedObject: (in category 'scanning') -----
+ placeEmbeddedObject: anchoredMorph
+ 	"Place the anchoredMorph or return false if it cannot be placed.
+ 	In any event, advance destX by its width."
+ 	| w |
+ 	"Workaround: The following should really use #textAnchorType"
+ 	anchoredMorph relativeTextAnchorPosition ifNotNil:[^true].
+ 	destX _ destX + (w _ anchoredMorph width).
+ 	(destX > rightMargin and: [(leftMargin + w) <= rightMargin])
+ 		ifTrue: ["Won't fit, but would on next line"
+ 				^ false].
+ 	lastIndex _ lastIndex + 1.
+ 	self setFont.  "Force recalculation of emphasis for next run"
+ 	^ true!

Item was added:
+ ----- Method: MultiCharacterScanner>>plainTab (in category 'scanning') -----
+ plainTab
+ 	"This is the basic method of adjusting destX for a tab."
+ 	destX _ (alignment == Justified and: [self leadingTab not])
+ 		ifTrue:		"embedded tabs in justified text are weird"
+ 			[destX + (textStyle tabWidth - (line justifiedTabDeltaFor: spaceCount)) max: destX]
+ 		ifFalse: 
+ 			[textStyle nextTabXFrom: destX
+ 				leftMargin: leftMargin
+ 				rightMargin: rightMargin]!

Item was added:
+ ----- Method: MultiCharacterScanner>>registerBreakableIndex (in category 'multilingual scanning') -----
+ registerBreakableIndex
+ 
+ 	"Record left x and character index of the line-wrappable point. 
+ 	The default implementation here does nothing."
+ 
+ 	^ false.
+ !

Item was added:
+ ----- Method: MultiCharacterScanner>>removeLastCharFromPresentation (in category 'multilingual scanning') -----
+ removeLastCharFromPresentation
+ !

Item was added:
+ ----- Method: MultiCharacterScanner>>scanCharactersFrom:to:in:rightX:stopConditions:kern: (in category 'scanning') -----
+ scanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta
+ 
+ 	| startEncoding selector |
+ 	(sourceString isByteString) ifTrue: [^ self basicScanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta.].
+ 
+ 	(sourceString isWideString) ifTrue: [
+ 		startIndex > stopIndex ifTrue: [lastIndex _ stopIndex. ^ stops at: EndOfRun].
+ 		startEncoding _  (sourceString at: startIndex) leadingChar.
+ 		selector _ EncodedCharSet scanSelectorAt: startEncoding.
+ 		^ self perform: selector withArguments: (Array with: startIndex with: stopIndex with: sourceString with: rightX with: stopConditions with: kernDelta).
+ 	].
+ 	
+ 	^ stops at: EndOfRun
+ !

Item was added:
+ ----- Method: MultiCharacterScanner>>scanJapaneseCharactersFrom:to:in:rightX:stopConditions:kern: (in category 'scanner methods') -----
+ scanJapaneseCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta
+ 
+ 	| ascii encoding f nextDestX maxAscii startEncoding |
+ 	lastIndex _ startIndex.
+ 	lastIndex > stopIndex ifTrue: [lastIndex _ stopIndex. ^ stops at: EndOfRun].
+ 	startEncoding _ (sourceString at: startIndex) leadingChar.
+ 	font ifNil: [font _ (TextConstants at: #DefaultMultiStyle) fontArray at: 1].
+ 	((font isMemberOf: StrikeFontSet) or: [font isKindOf: TTCFontSet]) ifTrue: [
+ 		[f _ font fontArray at: startEncoding + 1]
+ 			on: Exception do: [:ex | f _ font fontArray at: 1].
+ 		f ifNil: [ f _ font fontArray at: 1].
+ 		maxAscii _ f maxAscii.
+ 		"xTable _ f xTable.
+ 		maxAscii _ xTable size - 2."
+ 		spaceWidth _ f widthOf: Space.
+ 	] ifFalse: [
+ 		(font isMemberOf: HostFont) ifTrue: [
+ 			f _ font.
+ 			maxAscii _ f maxAscii.
+ 			spaceWidth _ f widthOf: Space.
+ 		] ifFalse: [
+ 			maxAscii _ font maxAscii.
+ 		].
+ 	].
+ 	[lastIndex <= stopIndex] whileTrue: [
+ 		"self halt."
+ 		encoding _ (sourceString at: lastIndex) leadingChar.
+ 		encoding ~= startEncoding ifTrue: [lastIndex _ lastIndex - 1. ^ stops at: EndOfRun].
+ 		ascii _ (sourceString at: lastIndex) charCode.
+ 		ascii > maxAscii ifTrue: [ascii _ maxAscii].
+ 		(encoding = 0 and: [(stopConditions at: ascii + 1) ~~ nil]) ifTrue: [^ stops at: ascii + 1].
+ 		(self isBreakableAt: lastIndex in: sourceString in: (EncodedCharSet charsetAt: encoding)) ifTrue: [
+ 			self registerBreakableIndex.
+ 		].
+ 		nextDestX _ destX + (font widthOf: (sourceString at: lastIndex)).
+ 		nextDestX > rightX ifTrue: [firstDestX ~= destX ifTrue: [^ stops at: CrossedX]].
+ 		destX _ nextDestX + kernDelta.
+ 		lastIndex _ lastIndex + 1.
+ 	].
+ 	lastIndex _ stopIndex.
+ 	^ stops at: EndOfRun!

Item was added:
+ ----- Method: MultiCharacterScanner>>scanMultiCharactersCombiningFrom:to:in:rightX:stopConditions:kern: (in category 'scanner methods') -----
+ scanMultiCharactersCombiningFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta
+ 
+ 	| charCode encoding f maxAscii startEncoding combining combined combiningIndex c |
+ 	lastIndex _ startIndex.
+ 	lastIndex > stopIndex ifTrue: [lastIndex _ stopIndex. ^ stops at: EndOfRun].
+ 	startEncoding _ (sourceString at: startIndex) leadingChar.
+ 	font ifNil: [font _ (TextConstants at: #DefaultMultiStyle) fontArray at: 1].
+ 	((font isMemberOf: StrikeFontSet) or: [font isKindOf: TTCFontSet]) ifTrue: [
+ 		[f _ font fontArray at: startEncoding + 1]
+ 			on: Exception do: [:ex | f _ font fontArray at: 1].
+ 		f ifNil: [ f _ font fontArray at: 1].
+ 		maxAscii _ f maxAscii.
+ 		spaceWidth _ font widthOf: Space.
+ 	] ifFalse: [
+ 		maxAscii _ font maxAscii.
+ 		spaceWidth _ font widthOf: Space.
+ 	].
+ 
+ 	combining _ nil.
+ 	[lastIndex <= stopIndex] whileTrue: [
+ 		charCode _ (sourceString at: lastIndex) charCode.
+ 		c _ (sourceString at: lastIndex).
+ 		combining ifNil: [
+ 			combining _ CombinedChar new.
+ 			combining add: c.
+ 			combiningIndex _ lastIndex.
+ 			lastIndex _ lastIndex + 1.
+ 		] ifNotNil: [
+ 			(combining add: c) ifFalse: [
+ 				self addCharToPresentation: (combined _ combining combined).
+ 				combining _ CombinedChar new.
+ 				combining add: c.
+ 				charCode _ combined charCode.
+ 				encoding _ combined leadingChar.
+ 				encoding ~= startEncoding ifTrue: [lastIndex _ lastIndex - 1.
+ 					(encoding = 0 and: [(stopConditions at: charCode + 1) ~~ nil]) ifTrue: [
+ 						^ stops at: charCode + 1
+ 					] ifFalse: [
+ 						 ^ stops at: EndOfRun
+ 					].
+ 				].
+ 				charCode > maxAscii ifTrue: [charCode _ maxAscii].
+ 				""
+ 				(encoding = 0 and: [(stopConditions at: charCode + 1) ~~ nil]) ifTrue: [
+ 					combining ifNotNil: [
+ 						self addCharToPresentation: (combining combined).
+ 					].
+ 					^ stops at: charCode + 1
+ 				].
+ 				(self isBreakableAt: lastIndex in: sourceString in: Latin1Environment) ifTrue: [
+ 					self registerBreakableIndex.
+ 				].		
+ 				destX > rightX ifTrue: [
+ 					destX ~= firstDestX ifTrue: [
+ 						lastIndex _ combiningIndex.
+ 						self removeLastCharFromPresentation.
+ 						^ stops at: CrossedX]].
+ 				combiningIndex _ lastIndex.
+ 				lastIndex _ lastIndex + 1.
+ 			] ifTrue: [
+ 				lastIndex _ lastIndex + 1.
+ 				numOfComposition _ numOfComposition + 1.
+ 			].
+ 		].
+ 	].
+ 	lastIndex _ stopIndex.
+ 	combining ifNotNil: [
+ 		combined _ combining combined.
+ 		self addCharToPresentation: combined.
+ 		"assuming that there is always enough space for at least one character".
+ 		destX _ destX + (self widthOf: combined inFont: font).
+ 	].
+ 	^ stops at: EndOfRun!

Item was added:
+ ----- Method: MultiCharacterScanner>>scanMultiCharactersFrom:to:in:rightX:stopConditions:kern: (in category 'scanning') -----
+ scanMultiCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta
+ 
+ 	| ascii encoding f nextDestX maxAscii startEncoding |
+ 	lastIndex _ startIndex.
+ 	lastIndex > stopIndex ifTrue: [lastIndex _ stopIndex. ^ stops at: EndOfRun].
+ 	startEncoding _ (sourceString at: startIndex) leadingChar.
+ 	font ifNil: [font _ (TextConstants at: #DefaultMultiStyle) fontArray at: 1].
+ 	((font isMemberOf: StrikeFontSet) or: [font isKindOf: TTCFontSet]) ifTrue: [
+ 		[f _ font fontArray at: startEncoding + 1]
+ 			on: Exception do: [:ex | f _ font fontArray at: 1].
+ 		f ifNil: [ f _ font fontArray at: 1].
+ 		maxAscii _ f maxAscii.
+ 		spaceWidth _ f widthOf: Space.
+ 	] ifFalse: [
+ 		maxAscii _ font maxAscii.
+ 	].
+ 
+ 	[lastIndex <= stopIndex] whileTrue: [
+ 		encoding _ (sourceString at: lastIndex) leadingChar.
+ 		encoding ~= startEncoding ifTrue: [lastIndex _ lastIndex - 1. ^ stops at: EndOfRun].
+ 		ascii _ (sourceString at: lastIndex) charCode.
+ 		ascii > maxAscii ifTrue: [ascii _ maxAscii].
+ 		(encoding = 0 and: [ascii < stopConditions size and: [(stopConditions at: ascii + 1) ~~ nil]]) ifTrue: [^ stops at: ascii + 1].
+ 		(self isBreakableAt: lastIndex in: sourceString in: Latin1Environment) ifTrue: [
+ 			self registerBreakableIndex.
+ 		].
+ 		nextDestX _ destX + (font widthOf: (sourceString at: lastIndex)).
+ 		nextDestX > rightX ifTrue: [destX ~= firstDestX ifTrue: [^ stops at: CrossedX]].
+ 		destX _ nextDestX + kernDelta.
+ 		lastIndex _ lastIndex + 1.
+ 	].
+ 	lastIndex _ stopIndex.
+ 	^ stops at: EndOfRun!

Item was added:
+ ----- Method: MultiCharacterScanner>>scanMultiCharactersR2LFrom:to:in:rightX:stopConditions:kern: (in category 'scanner methods') -----
+ scanMultiCharactersR2LFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta
+ 
+ 	"Note that 'rightX' really means 'endX' in R2L context.  Ie.  rightX is usually smaller than destX."
+ 	| ascii encoding f nextDestX maxAscii startEncoding |
+ 	lastIndex _ startIndex.
+ 	lastIndex > stopIndex ifTrue: [lastIndex _ stopIndex. ^ stops at: EndOfRun].
+ 	startEncoding _ (sourceString at: startIndex) leadingChar.
+ 	font ifNil: [font _ (TextConstants at: #DefaultMultiStyle) fontArray at: 1].
+ 	((font isMemberOf: StrikeFontSet) or: [font isKindOf: TTCFontSet]) ifTrue: [
+ 		[f _ font fontArray at: startEncoding + 1]
+ 			on: Exception do: [:ex | f _ font fontArray at: 1].
+ 		f ifNil: [ f _ font fontArray at: 1].
+ 		maxAscii _ f maxAscii.
+ 		spaceWidth _ f widthOf: Space.
+ 	] ifFalse: [
+ 		maxAscii _ font maxAscii.
+ 	].
+ 
+ 	[lastIndex <= stopIndex] whileTrue: [
+ 		encoding _ (sourceString at: lastIndex) leadingChar.
+ 		encoding ~= startEncoding ifTrue: [lastIndex _ lastIndex - 1. ^ stops at: EndOfRun].
+ 		ascii _ (sourceString at: lastIndex) charCode.
+ 		ascii > maxAscii ifTrue: [ascii _ maxAscii].
+ 		(encoding = 0 and: [(stopConditions at: ascii + 1) ~~ nil]) ifTrue: [^ stops at: ascii + 1].
+ 		(self isBreakableAt: lastIndex in: sourceString in: Latin1Environment) ifTrue: [
+ 			self registerBreakableIndex.
+ 		].
+ 		nextDestX _ destX - (font widthOf: (sourceString at: lastIndex)).
+ 		nextDestX < rightX ifTrue: [^ stops at: CrossedX].
+ 		destX _ nextDestX - kernDelta.
+ 		lastIndex _ lastIndex + 1.
+ 	].
+ 	lastIndex _ stopIndex.
+ 	^ stops at: EndOfRun!

Item was added:
+ ----- Method: MultiCharacterScanner>>scanSimChineseCharactersFrom:to:in:rightX:stopConditions:kern: (in category 'scanner methods') -----
+ scanSimChineseCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta
+ 
+ 	| ascii encoding f nextDestX maxAscii startEncoding |
+ 	lastIndex _ startIndex.
+ 	lastIndex > stopIndex ifTrue: [lastIndex _ stopIndex. ^ stops at: EndOfRun].
+ 	startEncoding _ (sourceString at: startIndex) leadingChar.
+ 	font ifNil: [font _ (TextConstants at: #DefaultMultiStyle) fontArray at: 1].
+ 	((font isMemberOf: StrikeFontSet) or: [font isKindOf: TTCFontSet]) ifTrue: [
+ 		[f _ font fontArray at: startEncoding + 1]
+ 			on: Exception do: [:ex | f _ font fontArray at: 1].
+ 		f ifNil: [ f _ font fontArray at: 1].
+ 		maxAscii _ f maxAscii.
+ 		"xTable _ f xTable.
+ 		maxAscii _ xTable size - 2."
+ 		spaceWidth _ f widthOf: Space.
+ 	] ifFalse: [
+ 		(font isMemberOf: HostFont) ifTrue: [
+ 			f _ font.
+ 			maxAscii _ f maxAscii.
+ 			spaceWidth _ f widthOf: Space.
+ 		] ifFalse: [
+ 			maxAscii _ font maxAscii.
+ 		].
+ 	].
+ 	[lastIndex <= stopIndex] whileTrue: [
+ 		"self halt."
+ 		encoding _ (sourceString at: lastIndex) leadingChar.
+ 		encoding ~= startEncoding ifTrue: [lastIndex _ lastIndex - 1. ^ stops at: EndOfRun].
+ 		ascii _ (sourceString at: lastIndex) charCode.
+ 		ascii > maxAscii ifTrue: [ascii _ maxAscii].
+ 		(encoding = 0 and: [(stopConditions at: ascii + 1) ~~ nil]) ifTrue: [^ stops at: ascii + 1].
+ 		(self isBreakableAt: lastIndex in: sourceString in: (EncodedCharSet charsetAt: encoding)) ifTrue: [
+ 			self registerBreakableIndex.
+ 		].
+ 		nextDestX _ destX + (font widthOf: (sourceString at: lastIndex)).
+ 		nextDestX > rightX ifTrue: [firstDestX ~= destX ifTrue: [^ stops at: CrossedX]].
+ 		destX _ nextDestX + kernDelta.
+ 		lastIndex _ lastIndex + 1.
+ 	].
+ 	lastIndex _ stopIndex.
+ 	^ stops at: EndOfRun!

Item was added:
+ ----- Method: MultiCharacterScanner>>setActualFont: (in category 'private') -----
+ setActualFont: aFont
+ 	"Set the basal font to an isolated font reference."
+ 
+ 	font _ aFont!

Item was added:
+ ----- Method: MultiCharacterScanner>>setAlignment: (in category 'private') -----
+ setAlignment: style
+ 	alignment _ style.
+ 	!

Item was added:
+ ----- Method: MultiCharacterScanner>>setConditionArray: (in category 'private') -----
+ setConditionArray: aSymbol
+ 
+ 	aSymbol == #paddedSpace ifTrue: [^stopConditions _ PaddedSpaceCondition "copy"].
+ 	"aSymbol == #space ifTrue: [^stopConditions _ SpaceCondition copy]."
+ 	aSymbol == nil ifTrue: [^stopConditions _ NilCondition "copy"].
+ 	self error: 'undefined stopcondition for space character'.
+ !

Item was added:
+ ----- Method: MultiCharacterScanner>>setFont (in category 'private') -----
+ setFont
+ 	| priorFont |
+ 	"Set the font and other emphasis."
+ 	priorFont _ font.
+ 	text == nil ifFalse:[
+ 		emphasisCode _ 0.
+ 		kern _ 0.
+ 		indentationLevel _ 0.
+ 		alignment _ textStyle alignment.
+ 		font _ nil.
+ 		(text attributesAt: lastIndex forStyle: textStyle)
+ 			do: [:att | att emphasizeScanner: self]].
+ 	font == nil ifTrue:
+ 		[self setFont: textStyle defaultFontIndex].
+ 	font _ font emphasized: emphasisCode.
+ 	priorFont ifNotNil: [destX _ destX + priorFont descentKern].
+ 	destX _ destX - font descentKern.
+ 	"NOTE: next statement should be removed when clipping works"
+ 	leftMargin ifNotNil: [destX _ destX max: leftMargin].
+ 	kern _ kern - font baseKern.
+ 
+ 	"Install various parameters from the font."
+ 	spaceWidth _ font widthOf: Space.
+ 	xTable _ font xTable.
+ "	map _ font characterToGlyphMap."
+ 	stopConditions _ DefaultStopConditions.!

Item was added:
+ ----- Method: MultiCharacterScanner>>setFont: (in category 'private') -----
+ setFont: fontNumber
+ 	"Set the font by number from the textStyle."
+ 
+ 	self setActualFont: (textStyle fontAt: fontNumber)!

Item was added:
+ ----- Method: MultiCharacterScanner>>text:textStyle: (in category 'private') -----
+ text: t textStyle: ts
+ 	text _ t.
+ 	textStyle _ ts!

Item was added:
+ ----- Method: MultiCharacterScanner>>textColor: (in category 'private') -----
+ textColor: ignored
+ 	"Overridden in DisplayScanner"!

Item was added:
+ ----- Method: MultiCharacterScanner>>wantsColumnBreaks: (in category 'initialize') -----
+ wantsColumnBreaks: aBoolean
+ 
+ 	wantsColumnBreaks _ aBoolean!

Item was added:
+ ----- Method: MultiCharacterScanner>>widthOf:inFont: (in category 'multilingual scanning') -----
+ widthOf: char inFont: aFont
+ 
+ 	(char isMemberOf: CombinedChar) ifTrue: [
+ 		^ aFont widthOf: char base.
+ 	] ifFalse: [
+ 		^ aFont widthOf: char.
+ 	].
+ 
+ 
+ !

Item was added:
+ MultiCharacterScanner subclass: #MultiCompositionScanner
+ 	instanceVariableNames: 'spaceX lineHeight baseline breakableIndex lineHeightAtBreak baselineAtBreak breakAtSpace lastWidth'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-Scanning'!

Item was added:
+ ----- Method: MultiCompositionScanner>>addCharToPresentation: (in category 'multilingual scanning') -----
+ addCharToPresentation: char
+ 
+ 	presentation nextPut: char.
+ 	lastWidth _ self widthOf: char inFont: font.
+ 	destX _ destX + lastWidth.
+ !

Item was added:
+ ----- Method: MultiCompositionScanner>>columnBreak (in category 'stop conditions') -----
+ columnBreak
+ 
+ 	"Answer true. Set up values for the text line interval currently being 
+ 	composed."
+ 
+ 	line stop: lastIndex.
+ 	presentationLine stop: lastIndex - numOfComposition.
+ 	spaceX _ destX.
+ 	line paddingWidth: rightMargin - spaceX.
+ 	presentationLine paddingWidth: rightMargin - spaceX.
+ 	^true!

Item was added:
+ ----- Method: MultiCompositionScanner>>composeFrom:inRectangle:firstLine:leftSide:rightSide: (in category 'scanning') -----
+ composeFrom: startIndex inRectangle: lineRectangle
+ 	firstLine: firstLine leftSide: leftSide rightSide: rightSide
+ 	"Answer an instance of TextLineInterval that represents the next line in the paragraph."
+ 	| runLength done stopCondition |
+ 	"Set up margins"
+ 	leftMargin _ lineRectangle left.
+ 	leftSide ifTrue: [leftMargin _ leftMargin +
+ 						(firstLine ifTrue: [textStyle firstIndent]
+ 								ifFalse: [textStyle restIndent])].
+ 	destX _ spaceX _ leftMargin.
+ 	firstDestX _ destX.
+ 	rightMargin _ lineRectangle right.
+ 	rightSide ifTrue: [rightMargin _ rightMargin - textStyle rightIndent].
+ 	lastIndex _ startIndex.	"scanning sets last index"
+ 	destY _ lineRectangle top.
+ 	lineHeight _ baseline _ 0.  "Will be increased by setFont"
+ 	self setStopConditions.	"also sets font"
+ 	runLength _ text runLengthFor: startIndex.
+ 	runStopIndex _ (lastIndex _ startIndex) + (runLength - 1).
+ 	line _ (TextLine start: lastIndex stop: 0 internalSpaces: 0 paddingWidth: 0)
+ 				rectangle: lineRectangle.
+ 	presentationLine _ (TextLine start: lastIndex stop: 0 internalSpaces: 0 paddingWidth: 0)
+ 				rectangle: lineRectangle.
+ 	numOfComposition _ 0.
+ 	spaceCount _ 0.
+ 	self handleIndentation.
+ 	leftMargin _ destX.
+ 	line leftMargin: leftMargin.
+ 	presentationLine leftMargin: leftMargin.
+ 
+ 	presentation _ TextStream on: (Text fromString: (WideString new: text size)).
+ 
+ 	done _ false.
+ 	[done]
+ 		whileFalse: 
+ 			[stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex
+ 				in: text string rightX: rightMargin stopConditions: stopConditions
+ 				kern: kern.
+ 			"See setStopConditions for stopping conditions for composing."
+ 			(self perform: stopCondition)
+ 				ifTrue: [presentationLine lineHeight: lineHeight + textStyle leading
+ 							baseline: baseline + textStyle leading.
+ 						^ line lineHeight: lineHeight + textStyle leading
+ 							baseline: baseline + textStyle leading]]!

Item was added:
+ ----- Method: MultiCompositionScanner>>composeLine:fromCharacterIndex:inParagraph: (in category 'scanning') -----
+ composeLine: lineIndex fromCharacterIndex: startIndex inParagraph: aParagraph 
+ 	"Answer an instance of TextLineInterval that represents the next line in the paragraph."
+ 	| runLength done stopCondition |
+ 	destX _ spaceX _ leftMargin _ aParagraph leftMarginForCompositionForLine: lineIndex.
+ 	destY _ 0.
+ 	rightMargin _ aParagraph rightMarginForComposition.
+ 	leftMargin >= rightMargin ifTrue: [self error: 'No room between margins to compose'].
+ 	lastIndex _ startIndex.	"scanning sets last index"
+ 	lineHeight _ textStyle lineGrid.  "may be increased by setFont:..."
+ 	baseline _ textStyle baseline.
+ 	baselineY _ destY + baseline.
+ 	self setStopConditions.	"also sets font"
+ 	self handleIndentation.
+ 	runLength _ text runLengthFor: startIndex.
+ 	runStopIndex _ (lastIndex _ startIndex) + (runLength - 1).
+ 	line _ TextLineInterval
+ 		start: lastIndex
+ 		stop: 0
+ 		internalSpaces: 0
+ 		paddingWidth: 0.
+ 	presentationLine _ TextLineInterval
+ 		start: lastIndex
+ 		stop: 0
+ 		internalSpaces: 0
+ 		paddingWidth: 0.
+ 	numOfComposition _ 0.
+ 	presentation _ TextStream on: (Text fromString: (WideString new: text size)).
+ 	spaceCount _ 0.
+ 	done _ false.
+ 	[done]
+ 		whileFalse: 
+ 			[stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex
+ 				in: text string rightX: rightMargin stopConditions: stopConditions
+ 				kern: kern.
+ 			"See setStopConditions for stopping conditions for composing."
+ 			(self perform: stopCondition)
+ 				ifTrue: [presentationLine lineHeight: lineHeight + textStyle leading
+ 							baseline: baseline + textStyle leading.
+ 						^line lineHeight: lineHeight + textStyle leading
+ 							baseline: baseline + textStyle leading]]!

Item was added:
+ ----- Method: MultiCompositionScanner>>cr (in category 'stop conditions') -----
+ cr
+ 	"Answer true. Set up values for the text line interval currently being 
+ 	composed."
+ 
+ 	line stop: lastIndex.
+ 	presentationLine stop: lastIndex - numOfComposition.
+ 	spaceX _ destX.
+ 	line paddingWidth: rightMargin - spaceX.
+ 	presentationLine paddingWidth: rightMargin - spaceX.
+ 	^true!

Item was added:
+ ----- Method: MultiCompositionScanner>>crossedX (in category 'stop conditions') -----
+ crossedX
+ 	"There is a word that has fallen across the right edge of the composition 
+ 	rectangle. This signals the need for wrapping which is done to the last 
+ 	space that was encountered, as recorded by the space stop condition."
+ 
+ 	(breakAtSpace) ifTrue: [
+ 		spaceCount >= 1 ifTrue:
+ 			["The common case. First back off to the space at which we wrap."
+ 			line stop: breakableIndex.
+ 			presentationLine stop: breakableIndex - numOfComposition.
+ 			lineHeight _ lineHeightAtBreak.
+ 			baseline _ baselineAtBreak.
+ 			spaceCount _ spaceCount - 1.
+ 			breakableIndex _ breakableIndex - 1.
+ 
+ 			"Check to see if any spaces preceding the one at which we wrap.
+ 				Double space after punctuation, most likely."
+ 			[(spaceCount > 1 and: [(text at: breakableIndex) = Space])]
+ 				whileTrue:
+ 					[spaceCount _ spaceCount - 1.
+ 					"Account for backing over a run which might
+ 						change width of space."
+ 					font _ text fontAt: breakableIndex withStyle: textStyle.
+ 					breakableIndex _ breakableIndex - 1.
+ 					spaceX _ spaceX - (font widthOf: Space)].
+ 			line paddingWidth: rightMargin - spaceX.
+ 			presentationLine paddingWidth: rightMargin - spaceX.
+ 			presentationLine internalSpaces: spaceCount.
+ 			line internalSpaces: spaceCount]
+ 		ifFalse:
+ 			["Neither internal nor trailing spaces -- almost never happens."
+ 			lastIndex _ lastIndex - 1.
+ 			[destX <= rightMargin]
+ 				whileFalse:
+ 					[destX _ destX - (font widthOf: (text at: lastIndex)).
+ 					lastIndex _ lastIndex - 1].
+ 			spaceX _ destX.
+ 			line paddingWidth: rightMargin - destX.
+ 			presentationLine paddingWidth: rightMargin - destX.
+ 			presentationLine stop: (lastIndex max: line first).
+ 			line stop: (lastIndex max: line first)].
+ 		^true
+ 	].
+ 
+ 	(breakableIndex isNil or: [breakableIndex < line first]) ifTrue: [
+ 		"Any breakable point in this line.  Just wrap last character."
+ 		breakableIndex _ lastIndex - 1.
+ 		lineHeightAtBreak _ lineHeight.
+ 		baselineAtBreak _ baseline.
+ 	].
+ 
+ 	"It wasn't a space, but anyway this is where we break the line."
+ 	line stop: breakableIndex.
+ 	presentationLine stop: breakableIndex.
+ 	lineHeight _ lineHeightAtBreak.
+ 	baseline _ baselineAtBreak.
+ 	^ true.
+ !

Item was added:
+ ----- Method: MultiCompositionScanner>>endOfRun (in category 'stop conditions') -----
+ endOfRun
+ 	"Answer true if scanning has reached the end of the paragraph. 
+ 	Otherwise step conditions (mostly install potential new font) and answer 
+ 	false."
+ 
+ 	| runLength |
+ 	lastIndex = text size
+ 	ifTrue:	[line stop: lastIndex.
+ 			presentationLine stop: lastIndex - numOfComposition.
+ 			spaceX _ destX.
+ 			line paddingWidth: rightMargin - destX.
+ 			presentationLine paddingWidth: rightMargin - destX.
+ 			^true]
+ 	ifFalse:	[
+ 			"(text at: lastIndex) charCode = 32 ifTrue: [destX _ destX + spaceWidth]."
+ 			runLength _ (text runLengthFor: (lastIndex _ lastIndex + 1)).
+ 			runStopIndex _ lastIndex + (runLength - 1).
+ 			self setStopConditions.
+ 			^false]
+ !

Item was added:
+ ----- Method: MultiCompositionScanner>>forParagraph: (in category 'intialize-release') -----
+ forParagraph: aParagraph
+ 	"Initialize the receiver for scanning the given paragraph."
+ 
+ 	self
+ 		initializeFromParagraph: aParagraph
+ 		clippedBy: aParagraph clippingRectangle.
+ !

Item was added:
+ ----- Method: MultiCompositionScanner>>getPresentation (in category 'multilingual scanning') -----
+ getPresentation
+ 
+ 	^ presentation contents.
+ 
+ !

Item was added:
+ ----- Method: MultiCompositionScanner>>getPresentationLine (in category 'multilingual scanning') -----
+ getPresentationLine
+ 
+ 	^ presentationLine.
+ !

Item was added:
+ ----- Method: MultiCompositionScanner>>isBreakableAt:in:in: (in category 'multilingual scanning') -----
+ isBreakableAt: index in: sourceString in: encodingClass
+ 
+ 	^ encodingClass isBreakableAt: index in: sourceString.
+ !

Item was added:
+ ----- Method: MultiCompositionScanner>>placeEmbeddedObject: (in category 'stop conditions') -----
+ placeEmbeddedObject: anchoredMorph
+ 	| descent |
+ 	"Workaround: The following should really use #textAnchorType"
+ 	anchoredMorph relativeTextAnchorPosition ifNotNil:[^true].
+ 	(super placeEmbeddedObject: anchoredMorph) ifFalse: ["It doesn't fit"
+ 		"But if it's the first character then leave it here"
+ 		lastIndex < line first ifFalse:[
+ 			line stop: lastIndex-1.
+ 			^ false]].
+ 	descent _ lineHeight - baseline.
+ 	lineHeight _ lineHeight max: anchoredMorph height.
+ 	baseline _ lineHeight - descent.
+ 	line stop: lastIndex.
+ 	presentationLine stop: lastIndex - numOfComposition.
+ 	^ true!

Item was added:
+ ----- Method: MultiCompositionScanner>>presentation (in category 'accessing') -----
+ presentation
+ 
+ 	^ presentation.
+ !

Item was added:
+ ----- Method: MultiCompositionScanner>>presentationLine (in category 'accessing') -----
+ presentationLine
+ 
+ 	^ presentationLine.
+ !

Item was added:
+ ----- Method: MultiCompositionScanner>>registerBreakableIndex (in category 'multilingual scanning') -----
+ registerBreakableIndex
+ 
+ 	"Record left x and character index of the line-wrappable point. 
+ 	Used for wrap-around. Answer whether the character has crossed the 
+ 	right edge of the composition rectangle of the paragraph."
+ 
+ 	(text at: lastIndex) = Character space ifTrue: [
+ 		breakAtSpace _ true.
+ 		spaceX _ destX.
+ 		spaceCount _ spaceCount + 1.
+ 		lineHeightAtBreak _ lineHeight.
+ 		baselineAtBreak _ baseline.
+ 		breakableIndex _ lastIndex.
+ 		destX > rightMargin ifTrue: 	[^self crossedX].
+ 	] ifFalse: [
+ 		breakAtSpace _ false.
+ 		lineHeightAtBreak _ lineHeight.
+ 		baselineAtBreak _ baseline.
+ 		breakableIndex _ lastIndex - 1.
+ 	].
+ 	^ false.
+ !

Item was added:
+ ----- Method: MultiCompositionScanner>>removeLastCharFromPresentation (in category 'multilingual scanning') -----
+ removeLastCharFromPresentation
+ 
+ 	presentation ifNotNil: [
+ 		presentation position: presentation position - 1.
+ 	].
+ 	destX _ destX - lastWidth.
+ !

Item was added:
+ ----- Method: MultiCompositionScanner>>rightX (in category 'accessing') -----
+ rightX
+ 	"Meaningful only when a line has just been composed -- refers to the 
+ 	line most recently composed. This is a subtrefuge to allow for easy 
+ 	resizing of a composition rectangle to the width of the maximum line. 
+ 	Useful only when there is only one line in the form or when each line 
+ 	is terminated by a carriage return. Handy for sizing menus and lists."
+ 
+ 	breakAtSpace ifTrue: [^ spaceX].
+ 
+ 	^ destX.
+ !

Item was added:
+ ----- Method: MultiCompositionScanner>>setActualFont: (in category 'scanning') -----
+ setActualFont: aFont
+ 	"Keep track of max height and ascent for auto lineheight"
+ 	| descent |
+ 	super setActualFont: aFont.
+ 	"'   ', lastIndex printString, '   ' displayAt: (lastIndex * 15)@0."
+ 	lineHeight == nil
+ 		ifTrue: [descent _ font descent.
+ 				baseline _ font ascent.
+ 				lineHeight _ baseline + descent]
+ 		ifFalse: [descent _ lineHeight - baseline max: font descent.
+ 				baseline _ baseline max: font ascent.
+ 				lineHeight _ lineHeight max: baseline + descent]!

Item was added:
+ ----- Method: MultiCompositionScanner>>setFont (in category 'stop conditions') -----
+ setFont
+ 	super setFont.
+ 	breakAtSpace _ false.
+ 	wantsColumnBreaks == true ifTrue: [
+ 		stopConditions _ stopConditions copy.
+ 		stopConditions at: TextComposer characterForColumnBreak asciiValue + 1 put: #columnBreak.
+ 	].
+ !

Item was added:
+ ----- Method: MultiCompositionScanner>>setStopConditions (in category 'stop conditions') -----
+ setStopConditions
+ 	"Set the font and the stop conditions for the current run."
+ 	
+ 	self setFont!

Item was added:
+ ----- Method: MultiCompositionScanner>>tab (in category 'stop conditions') -----
+ tab
+ 	"Advance destination x according to tab settings in the paragraph's 
+ 	textStyle. Answer whether the character has crossed the right edge of 
+ 	the composition rectangle of the paragraph."
+ 
+ 	destX _ textStyle
+ 				nextTabXFrom: destX leftMargin: leftMargin rightMargin: rightMargin.
+ 	destX > rightMargin ifTrue:	[^self crossedX].
+ 	lastIndex _ lastIndex + 1.
+ 	^false
+ !

Item was added:
+ MultiCharacterScanner subclass: #MultiDisplayScanner
+ 	instanceVariableNames: 'bitBlt lineY runX foregroundColor backgroundColor fillBlt lineHeight paragraph paragraphColor morphicOffset ignoreColorChanges'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-Scanning'!

Item was added:
+ ----- Method: MultiDisplayScanner class>>defaultFont (in category 'queries') -----
+ defaultFont
+ 	^ TextStyle defaultFont!

Item was added:
+ ----- Method: MultiDisplayScanner>>cr (in category 'stop conditions') -----
+ cr
+ 	"When a carriage return is encountered, simply increment the pointer 
+ 	into the paragraph."
+ 
+ 	lastIndex_ lastIndex + 1.
+ 	^false!

Item was added:
+ ----- Method: MultiDisplayScanner>>crossedX (in category 'stop conditions') -----
+ crossedX
+ 	"This condition will sometimes be reached 'legally' during display, when, 
+ 	for instance the space that caused the line to wrap actually extends over 
+ 	the right boundary. This character is allowed to display, even though it 
+ 	is technically outside or straddling the clipping ectangle since it is in 
+ 	the normal case not visible and is in any case appropriately clipped by 
+ 	the scanner."
+ 
+ 	^ true !

Item was added:
+ ----- Method: MultiDisplayScanner>>displayLine:offset:leftInRun: (in category 'scanning') -----
+ displayLine: textLine offset: offset leftInRun: leftInRun
+ 	"The call on the primitive (scanCharactersFrom:to:in:rightX:) will be interrupted according to an array of stop conditions passed to the scanner at which time the code to handle the stop condition is run and the call on the primitive continued until a stop condition returns true (which means the line has terminated).  leftInRun is the # of characters left to scan in the current run; when 0, it is time to call setStopConditions."
+ 	| done stopCondition nowLeftInRun startIndex string lastPos |
+ 	line := textLine.
+ 	morphicOffset := offset.
+ 	lineY := line top + offset y.
+ 	lineHeight := line lineHeight.
+ 	rightMargin := line rightMargin + offset x.
+ 	lastIndex := line first.
+ 	leftInRun <= 0 ifTrue: [self setStopConditions].
+ 	leftMargin := (line leftMarginForAlignment: alignment) + offset x.
+ 	destX := runX := leftMargin.
+ 	fillBlt == nil ifFalse:
+ 		["Not right"
+ 		fillBlt destX: line left destY: lineY
+ 			width: line width left height: lineHeight; copyBits].
+ 	lastIndex := line first.
+ 	leftInRun <= 0
+ 		ifTrue: [nowLeftInRun := text runLengthFor: lastIndex]
+ 		ifFalse: [nowLeftInRun := leftInRun].
+ 	baselineY := lineY + line baseline.
+ 	destY := baselineY - font ascent.
+ 	runStopIndex := lastIndex + (nowLeftInRun - 1) min: line last.
+ 	spaceCount := 0.
+ 	done := false.
+ 	string := text string.
+ 	[done] whileFalse:[
+ 		startIndex := lastIndex.
+ 		lastPos := destX at destY.
+ 		stopCondition := self scanCharactersFrom: lastIndex to: runStopIndex
+ 						in: string rightX: rightMargin stopConditions: stopConditions
+ 						kern: kern.
+ 		lastIndex >= startIndex ifTrue:[
+ 			font displayString: string on: bitBlt 
+ 				from: startIndex 
+ 	"XXXX: The following is an interesting bug. All stopConditions exept #endOfRun
+ 		have lastIndex past the last character displayed. #endOfRun sets it *on* the character.
+ 		If we display up until lastIndex then we will also display invisible characters like
+ 		CR and tab. This problem should be fixed in the scanner (i.e., position lastIndex
+ 		consistently) but I don't want to deal with the fallout right now so we keep the
+ 		fix minimally invasive."
+ 				to: (stopCondition == #endOfRun ifTrue:[lastIndex] ifFalse:[lastIndex-1])
+ 				at: lastPos kern: kern baselineY: baselineY].
+ 		"see setStopConditions for stopping conditions for displaying."
+ 		done := self perform: stopCondition.
+ 		"lastIndex > runStopIndex ifTrue: [done := true]."
+ 	].
+ 	^ runStopIndex - lastIndex   "Number of characters remaining in the current run"!

Item was added:
+ ----- Method: MultiDisplayScanner>>displayLines:in:clippedBy: (in category 'MVC-compatibility') -----
+ displayLines: linesInterval in: aParagraph clippedBy: visibleRectangle
+ 	"The central display routine. The call on the primitive 
+ 	(scanCharactersFrom:to:in:rightX:) will be interrupted according to an 
+ 	array of stop conditions passed to the scanner at which time the code to 
+ 	handle the stop condition is run and the call on the primitive continued 
+ 	until a stop condition returns true (which means the line has 
+ 	terminated)."
+ 	| runLength done stopCondition leftInRun startIndex string lastPos |
+ 	"leftInRun is the # of characters left to scan in the current run;
+ 		when 0, it is time to call 'self setStopConditions'"
+ 	morphicOffset _ 0 at 0.
+ 	leftInRun _ 0.
+ 	self initializeFromParagraph: aParagraph clippedBy: visibleRectangle.
+ 	ignoreColorChanges _ false.
+ 	paragraph _ aParagraph.
+ 	foregroundColor _ paragraphColor _ aParagraph foregroundColor.
+ 	backgroundColor _ aParagraph backgroundColor.
+ 	aParagraph backgroundColor isTransparent
+ 		ifTrue: [fillBlt _ nil]
+ 		ifFalse: [fillBlt _ bitBlt copy.  "Blt to fill spaces, tabs, margins"
+ 				fillBlt sourceForm: nil; sourceOrigin: 0 at 0.
+ 				fillBlt fillColor: aParagraph backgroundColor].
+ 	rightMargin _ aParagraph rightMarginForDisplay.
+ 	lineY _ aParagraph topAtLineIndex: linesInterval first.
+ 	bitBlt destForm deferUpdatesIn: visibleRectangle while: [
+ 		linesInterval do: 
+ 			[:lineIndex | 
+ 			leftMargin _ aParagraph leftMarginForDisplayForLine: lineIndex alignment: (alignment ifNil:[textStyle alignment]).
+ 			destX _ (runX _ leftMargin).
+ 			line _ aParagraph lines at: lineIndex.
+ 			lineHeight _ line lineHeight.
+ 			fillBlt == nil ifFalse:
+ 				[fillBlt destX: visibleRectangle left destY: lineY
+ 					width: visibleRectangle width height: lineHeight; copyBits].
+ 			lastIndex _ line first.
+ 			leftInRun <= 0
+ 				ifTrue: [self setStopConditions.  "also sets the font"
+ 						leftInRun _ text runLengthFor: line first].
+ 			baselineY _ lineY + line baseline.
+ 			destY _ baselineY - font ascent.  "Should have happened in setFont"
+ 			runLength _ leftInRun.
+ 			runStopIndex _ lastIndex + (runLength - 1) min: line last.
+ 			leftInRun _ leftInRun - (runStopIndex - lastIndex + 1).
+ 			spaceCount _ 0.
+ 			done _ false.
+ 			string _ text string.
+ 			self handleIndentation.
+ 			[done] whileFalse:[
+ 				startIndex _ lastIndex.
+ 				lastPos _ destX at destY.
+ 				stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex
+ 							in: string rightX: rightMargin stopConditions: stopConditions
+ 							kern: kern.
+ 				lastIndex >= startIndex ifTrue:[
+ 					font displayString: string on: bitBlt 
+ 						from: startIndex to: lastIndex at: lastPos kern: kern baselineY: baselineY].
+ 				"see setStopConditions for stopping conditions for displaying."
+ 				done _ self perform: stopCondition].
+ 			fillBlt == nil ifFalse:
+ 				[fillBlt destX: destX destY: lineY width: visibleRectangle right-destX height: lineHeight; copyBits].
+ 			lineY _ lineY + lineHeight]]!

Item was added:
+ ----- Method: MultiDisplayScanner>>endOfRun (in category 'stop conditions') -----
+ endOfRun
+ 	"The end of a run in the display case either means that there is actually 
+ 	a change in the style (run code) to be associated with the string or the 
+ 	end of this line has been reached."
+ 	| runLength |
+ 	lastIndex = line last ifTrue: [^true].
+ 	runX _ destX.
+ 	runLength _ text runLengthFor: (lastIndex _ lastIndex + 1).
+ 	runStopIndex _ lastIndex + (runLength - 1) min: line last.
+ 	self setStopConditions.
+ 	^ false!

Item was added:
+ ----- Method: MultiDisplayScanner>>initializeFromParagraph:clippedBy: (in category 'MVC-compatibility') -----
+ initializeFromParagraph: aParagraph clippedBy: clippingRectangle
+ 
+ 	super initializeFromParagraph: aParagraph clippedBy: clippingRectangle.
+ 	bitBlt _ BitBlt asGrafPort toForm: aParagraph destinationForm.
+ 	bitBlt sourceX: 0; width: 0.	"Init BitBlt so that the first call to a primitive will not fail"
+ 	bitBlt combinationRule: Form paint.
+ 	bitBlt colorMap:
+ 		(Bitmap with: 0      "Assumes 1-bit deep fonts"
+ 				with: (bitBlt destForm pixelValueFor: aParagraph foregroundColor)).
+ 	bitBlt clipRect: clippingRectangle.
+ !

Item was added:
+ ----- Method: MultiDisplayScanner>>isBreakableAt:in:in: (in category 'multilingual scanning') -----
+ isBreakableAt: index in: sourceString in: encodingClass
+ 
+ 	^ false.
+ !

Item was added:
+ ----- Method: MultiDisplayScanner>>paddedSpace (in category 'stop conditions') -----
+ paddedSpace
+ 	"Each space is a stop condition when the alignment is right justified. 
+ 	Padding must be added to the base width of the space according to 
+ 	which space in the line this space is and according to the amount of 
+ 	space that remained at the end of the line when it was composed."
+ 
+ 	spaceCount _ spaceCount + 1.
+ 	destX _ destX + spaceWidth + (line justifiedPadFor: spaceCount).
+ 	lastIndex _ lastIndex + 1.
+ 	^ false!

Item was added:
+ ----- Method: MultiDisplayScanner>>placeEmbeddedObject: (in category 'scanning') -----
+ placeEmbeddedObject: anchoredMorph
+ 	anchoredMorph relativeTextAnchorPosition ifNotNil:[
+ 		anchoredMorph position: 
+ 			anchoredMorph relativeTextAnchorPosition +
+ 			(anchoredMorph owner textBounds origin x @ 0)
+ 			- (0 at morphicOffset y) + (0 at lineY).
+ 		^true
+ 	].
+ 	(super placeEmbeddedObject: anchoredMorph) ifFalse: [^ false].
+ 	anchoredMorph isMorph ifTrue: [
+ 		anchoredMorph position: ((destX - anchoredMorph width)@lineY) - morphicOffset
+ 	] ifFalse: [
+ 		destY _ lineY.
+ 		baselineY _ lineY + anchoredMorph height..
+ 		runX _ destX.
+ 		anchoredMorph 
+ 			displayOn: bitBlt destForm 
+ 			at: destX - anchoredMorph width @ destY
+ 			clippingBox: bitBlt clipRect
+ 	].
+ 	^ true!

Item was added:
+ ----- Method: MultiDisplayScanner>>plainTab (in category 'stop conditions') -----
+ plainTab
+ 	| oldX |
+ 	oldX _ destX.
+ 	super plainTab.
+ 	fillBlt == nil ifFalse:
+ 		[fillBlt destX: oldX destY: destY width: destX - oldX height: font height; copyBits]!

Item was added:
+ ----- Method: MultiDisplayScanner>>presentationText: (in category 'private') -----
+ presentationText: t
+ 
+ 	text _ t.
+ !

Item was added:
+ ----- Method: MultiDisplayScanner>>scanMultiCharactersCombiningFrom:to:in:rightX:stopConditions:kern: (in category 'multilingual scanning') -----
+ scanMultiCharactersCombiningFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta
+ 
+ 	| encoding f nextDestX maxAscii startEncoding char charValue |
+ 	lastIndex _ startIndex.
+ 	lastIndex > stopIndex ifTrue: [lastIndex _ stopIndex. ^ stops at: EndOfRun].
+ 	startEncoding _ (sourceString at: startIndex) leadingChar.
+ 	font ifNil: [font _ (TextConstants at: #DefaultMultiStyle) fontArray at: 1].
+ 	((font isMemberOf: StrikeFontSet) or: [font isKindOf: TTCFontSet]) ifTrue: [
+ 		[f _ font fontArray at: startEncoding + 1]
+ 			on: Exception do: [:ex | f _ font fontArray at: 1].
+ 		f ifNil: [ f _ font fontArray at: 1].
+ 		maxAscii _ f maxAscii.
+ 		spaceWidth _ f widthOf: Space.
+ 	] ifFalse: [
+ 		maxAscii _ font maxAscii.
+ 	].
+ 
+ 	[lastIndex <= stopIndex] whileTrue: [
+ 		encoding _ (sourceString at: lastIndex) leadingChar.
+ 		encoding ~= startEncoding ifTrue: [lastIndex _ lastIndex - 1. ^ stops at: EndOfRun].
+ 		char _ (sourceString at: lastIndex).
+ 		charValue _ char charCode.
+ 		charValue > maxAscii ifTrue: [charValue _ maxAscii].
+ 		(encoding = 0 and: [(stopConditions at: charValue + 1) ~~ nil]) ifTrue: [
+ 			^ stops at: charValue + 1
+ 		].
+ 		nextDestX _ destX + (self widthOf: char inFont: font).
+ 		nextDestX > rightX ifTrue: [^ stops at: CrossedX].
+ 		destX _ nextDestX + kernDelta.
+ 		lastIndex _ lastIndex + 1.
+ 	].
+ 	lastIndex _ stopIndex.
+ 	^ stops at: EndOfRun!

Item was added:
+ ----- Method: MultiDisplayScanner>>setDestForm: (in category 'private') -----
+ setDestForm: df
+ 	bitBlt setDestForm: df.!

Item was added:
+ ----- Method: MultiDisplayScanner>>setFont (in category 'private') -----
+ setFont 
+ 	foregroundColor _ paragraphColor.
+ 	super setFont.  "Sets font and emphasis bits, and maybe foregroundColor"
+ 	font installOn: bitBlt foregroundColor: foregroundColor backgroundColor: Color transparent.
+ 	text ifNotNil:[
+ 		baselineY _ lineY + line baseline.
+ 		destY _ baselineY - font ascent].
+ !

Item was added:
+ ----- Method: MultiDisplayScanner>>setPort: (in category 'private') -----
+ setPort: aBitBlt
+ 	"Install the BitBlt to use"
+ 	bitBlt _ aBitBlt.
+ 	bitBlt sourceX: 0; width: 0.	"Init BitBlt so that the first call to a primitive will not fail"
+ 	bitBlt sourceForm: nil. "Make sure font installation won't be confused"
+ !

Item was added:
+ ----- Method: MultiDisplayScanner>>setStopConditions (in category 'stop conditions') -----
+ setStopConditions
+ 	"Set the font and the stop conditions for the current run."
+ 	
+ 	self setFont.
+ 	self setConditionArray: (alignment = Justified ifTrue: [#paddedSpace]).
+ 
+ "
+ 	alignment = Justified ifTrue: [
+ 		stopConditions == DefaultStopConditions 
+ 			ifTrue:[stopConditions _ stopConditions copy].
+ 		stopConditions at: Space asciiValue + 1 put: #paddedSpace]
+ "!

Item was added:
+ ----- Method: MultiDisplayScanner>>tab (in category 'stop conditions') -----
+ tab
+ 	self plainTab.
+ 	lastIndex _ lastIndex + 1.
+ 	^ false!

Item was added:
+ ----- Method: MultiDisplayScanner>>text:textStyle:foreground:background:fillBlt:ignoreColorChanges: (in category 'private') -----
+ text: t textStyle: ts foreground: foreColor background: backColor fillBlt: blt ignoreColorChanges: shadowMode
+ 	text _ t.
+ 	textStyle _ ts. 
+ 	foregroundColor _ paragraphColor _ foreColor.
+ 	(backgroundColor _ backColor) isTransparent ifFalse:
+ 		[fillBlt _ blt.
+ 		fillBlt fillColor: backgroundColor].
+ 	ignoreColorChanges _ shadowMode!

Item was added:
+ ----- Method: MultiDisplayScanner>>textColor: (in category 'private') -----
+ textColor: textColor
+ 	ignoreColorChanges ifTrue: [^ self].
+ 	foregroundColor _ textColor!

Item was added:
+ NewParagraph subclass: #MultiNewParagraph
+ 	instanceVariableNames: 'presentationText presentationLines'
+ 	classVariableNames: ''
+ 	poolDictionaries: 'TextConstants'
+ 	category: 'Etoys-Squeakland-Multilingual-Scanning'!

Item was added:
+ ----- Method: MultiNewParagraph>>displayOn:using:at: (in category 'fonts-display') -----
+ displayOn: aCanvas using: displayScanner at: somePosition
+ 	"Send all visible lines to the displayScanner for display"
+ 
+ 	| visibleRectangle offset leftInRun line |
+ 	visibleRectangle _ aCanvas clipRect.
+ 	offset _ somePosition - positionWhenComposed.
+ 	leftInRun _ 0.
+ 	(self lineIndexForPoint: visibleRectangle topLeft)
+ 		to: (self lineIndexForPoint: visibleRectangle bottomRight)
+ 		do: [:i | line _ lines at: i.
+ 			self displaySelectionInLine: line on: aCanvas.
+ 			line first <= line last ifTrue:
+ 				[leftInRun _ displayScanner displayLine: line
+ 								offset: offset leftInRun: leftInRun]].
+ !

Item was added:
+ ----- Method: MultiNewParagraph>>displayOnTest:using:at: (in category 'fonts-display') -----
+ displayOnTest: aCanvas using: displayScanner at: somePosition
+ 	"Send all visible lines to the displayScanner for display"
+ 
+ 	| visibleRectangle offset leftInRun line |
+ 	(presentationText isNil or: [presentationLines isNil]) ifTrue: [
+ 		^ self displayOn: aCanvas using: displayScanner at: somePosition.
+ 	].
+ 	visibleRectangle _ aCanvas clipRect.
+ 	offset _ somePosition - positionWhenComposed.
+ 	leftInRun _ 0.
+ 	(self lineIndexForPoint: visibleRectangle topLeft)
+ 		to: (self lineIndexForPoint: visibleRectangle bottomRight)
+ 		do: [:i | line _ presentationLines at: i.
+ 			self displaySelectionInLine: line on: aCanvas.
+ 			line first <= line last ifTrue:
+ 				[leftInRun _ displayScanner displayLine: line
+ 								offset: offset leftInRun: leftInRun]].
+ !

Item was added:
+ ----- Method: MultiNewParagraph>>multiComposeLinesFrom:to:delta:into:priorLines:atY: (in category 'composition') -----
+ multiComposeLinesFrom: start to: stop delta: delta into: lineColl priorLines: priorLines
+ 	atY: startingY
+ 	"While the section from start to stop has changed, composition may ripple all the way to the end of the text.  However in a rectangular container, if we ever find a line beginning with the same character as before (ie corresponding to delta in the old lines), then we can just copy the old lines from there to the end of the container, with adjusted indices and y-values"
+ 
+ 	| newResult composer presentationInfo |
+ 
+ 	composer _ MultiTextComposer new.
+ 	presentationLines _ nil.
+ 	presentationText _ nil.
+ 	newResult _ composer
+ 		multiComposeLinesFrom: start 
+ 		to: stop 
+ 		delta: delta 
+ 		into: lineColl 
+ 		priorLines: priorLines
+ 		atY: startingY
+ 		textStyle: textStyle 
+ 		text: text 
+ 		container: container
+ 		wantsColumnBreaks: wantsColumnBreaks == true.
+ 	lines _ newResult first asArray.
+ 	maxRightX _ newResult second.
+ 	presentationInfo _ composer getPresentationInfo.
+ 	presentationLines _ presentationInfo first asArray.
+ 	presentationText _ presentationInfo second.
+ 	"maxRightX printString displayAt: 0 at 0."
+ 	^maxRightX
+ !

Item was added:
+ ----- Method: MultiNewParagraph>>presentationLines (in category 'accessing') -----
+ presentationLines
+ 
+ 	^ presentationLines.
+ !

Item was added:
+ ----- Method: MultiNewParagraph>>presentationText (in category 'accessing') -----
+ presentationText
+ 
+ 	^ presentationText.
+ !

Item was added:
+ TextComposer subclass: #MultiTextComposer
+ 	instanceVariableNames: 'presentation presentationLines'
+ 	classVariableNames: ''
+ 	poolDictionaries: 'TextConstants'
+ 	category: 'Etoys-Squeakland-Multilingual-Scanning'!

Item was added:
+ ----- Method: MultiTextComposer>>composeEachRectangleIn: (in category 'as yet unclassified') -----
+ composeEachRectangleIn: rectangles
+ 
+ 	| myLine lastChar |
+ 
+ 	1 to: rectangles size do: [:i | 
+ 		currCharIndex <= theText size ifFalse: [^false].
+ 		myLine _ scanner 
+ 			composeFrom: currCharIndex 
+ 			inRectangle: (rectangles at: i)				
+ 			firstLine: isFirstLine 
+ 			leftSide: i=1 
+ 			rightSide: i=rectangles size.
+ 		lines addLast: myLine.
+ 		presentationLines addLast: scanner getPresentationLine.
+ 		presentation ifNil: [presentation _ scanner getPresentation]
+ 			ifNotNil: [presentation _ presentation, scanner getPresentation].
+ 		actualHeight _ actualHeight max: myLine lineHeight.  "includes font changes"
+ 		currCharIndex _ myLine last + 1.
+ 		lastChar _ theText at: myLine last.
+ 		lastChar = Character cr ifTrue: [^#cr].
+ 		wantsColumnBreaks ifTrue: [
+ 			lastChar = TextComposer characterForColumnBreak ifTrue: [^#columnBreak].
+ 		].
+ 	].
+ 	^false!

Item was added:
+ ----- Method: MultiTextComposer>>getPresentationInfo (in category 'as yet unclassified') -----
+ getPresentationInfo
+ 
+ 	^ Array with: presentationLines with: presentation.
+ !

Item was added:
+ ----- Method: MultiTextComposer>>multiComposeLinesFrom:to:delta:into:priorLines:atY:textStyle:text:container:wantsColumnBreaks: (in category 'as yet unclassified') -----
+ multiComposeLinesFrom: argStart to: argStop delta: argDelta into: argLinesCollection priorLines: argPriorLines atY: argStartY textStyle: argTextStyle text: argText container: argContainer wantsColumnBreaks: argWantsColumnBreaks
+ 
+ 	wantsColumnBreaks _ argWantsColumnBreaks.
+ 	lines _ argLinesCollection.
+ 	presentationLines _ argLinesCollection copy.
+ 	theTextStyle _ argTextStyle.
+ 	theText _ argText.
+ 	theContainer _ argContainer.
+ 	deltaCharIndex _ argDelta.
+ 	currCharIndex _ startCharIndex _ argStart.
+ 	stopCharIndex _ argStop.
+ 	prevLines _ argPriorLines.
+ 	currentY _ argStartY.
+ 	defaultLineHeight _ theTextStyle lineGrid.
+ 	maxRightX _ theContainer left.
+ 	possibleSlide _ stopCharIndex < theText size and: [theContainer isMemberOf: Rectangle].
+ 	nowSliding _ false.
+ 	prevIndex _ 1.
+ 	scanner _ MultiCompositionScanner new text: theText textStyle: theTextStyle.
+ 	scanner wantsColumnBreaks: wantsColumnBreaks.
+ 	isFirstLine _ true.
+ 	self composeAllLines.
+ 	isFirstLine ifTrue: ["No space in container or empty text"
+ 		self 
+ 			addNullLineWithIndex: startCharIndex
+ 			andRectangle: (theContainer topLeft extent: 0 at defaultLineHeight)
+ 	] ifFalse: [
+ 		self fixupLastLineIfCR
+ 	].
+ 	^{lines asArray. maxRightX}
+ 
+ !

Item was added:
+ SketchMorph subclass: #MultiuserTinyPaint
+ 	instanceVariableNames: 'drawState'
+ 	classVariableNames: 'LastMouseIndex PenColorIndex PenIndex PenSizeIndex'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Widgets'!
+ 
+ !MultiuserTinyPaint commentStamp: '<historical>' prior: 0!
+ A very simple paint program that handles multiple users (hands).
+ Each user has their own brush size and color.
+ !

Item was added:
+ ----- Method: MultiuserTinyPaint class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"MultiuserTinyPaint initialize"
+ 
+ 	"indices into the state array for a given hand"
+ 	PenIndex _ 1.
+ 	PenSizeIndex _ 2.
+ 	PenColorIndex _ 3.
+ 	LastMouseIndex _ 4.
+ !

Item was added:
+ ----- Method: MultiuserTinyPaint>>addCustomMenuItems:hand: (in category 'menu') -----
+ addCustomMenuItems: aCustomMenu hand: aHandMorph
+ 
+ 	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ 	aCustomMenu add: 'clear' translated action: #clear.
+ 	aCustomMenu add: 'pen color' translated action: #setPenColor:.
+ 	aCustomMenu add: 'pen size' translated action: #setPenSize:.
+ "	aCustomMenu add: 'fill' translated action: #fill:."
+ !

Item was added:
+ ----- Method: MultiuserTinyPaint>>brushColor:hand: (in category 'menu') -----
+ brushColor: aColor hand: hand
+ 
+ 	| state |
+ 	(drawState includesKey: hand) ifFalse: [self createDrawStateFor: hand].
+ 	state _ drawState at: hand.
+ 	(state at: PenIndex) color: aColor.
+ 	state at: PenColorIndex put: aColor.
+ !

Item was added:
+ ----- Method: MultiuserTinyPaint>>clear (in category 'menu') -----
+ clear
+ 
+ 	| newPen |
+ 	self form: ((Form extent: 400 at 300 depth: 8) fillColor: color).
+ 	drawState do: [:state |
+ 		newPen _ Pen newOnForm: originalForm.
+ 		newPen roundNib: (state at: PenSizeIndex).
+ 		newPen color: (state at: PenColorIndex).
+ 		state at: PenIndex put: newPen].
+ !

Item was added:
+ ----- Method: MultiuserTinyPaint>>createDrawStateFor: (in category 'private') -----
+ createDrawStateFor: aHand
+ 
+ 	| pen state |
+ 	pen _ Pen newOnForm: originalForm.
+ 	state _ Array new: 4.
+ 	state at: PenIndex put: pen.
+ 	state at: PenSizeIndex put: 3.
+ 	state at: PenColorIndex put: Color red.
+ 	state at: LastMouseIndex put: nil.
+ 	drawState at: aHand put: state.
+ !

Item was added:
+ ----- Method: MultiuserTinyPaint>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color veryVeryLightGray!

Item was added:
+ ----- Method: MultiuserTinyPaint>>fill: (in category 'menu') -----
+ fill: evt
+ 
+ 	| state fillPt |
+ 	(drawState includesKey: evt hand) ifFalse: [self createDrawStateFor: evt hand].
+ 	state _ drawState at: evt hand.
+ 
+ 	Cursor blank show.
+ 	Cursor crossHair showWhile:
+ 		[fillPt _ Sensor waitButton - self position].
+ 	originalForm shapeFill: (state at: PenColorIndex) interiorPoint: fillPt.
+ 	self changed.
+ !

Item was added:
+ ----- Method: MultiuserTinyPaint>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: evt
+ 
+ 	^ true
+ !

Item was added:
+ ----- Method: MultiuserTinyPaint>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	
+ 	drawState _ IdentityDictionary new.
+ 	self clear!

Item was added:
+ ----- Method: MultiuserTinyPaint>>mouseDown: (in category 'event handling') -----
+ mouseDown: evt
+ 
+ 	| state |
+ 	(drawState includesKey: evt hand) ifFalse: [self createDrawStateFor: evt hand].
+ 	state _ drawState at: evt hand.
+ 	state at: LastMouseIndex put: evt cursorPoint.
+ !

Item was added:
+ ----- Method: MultiuserTinyPaint>>mouseMove: (in category 'event handling') -----
+ mouseMove: evt
+ 
+ 	| state lastP p pen |
+ 	state _ drawState at: evt hand ifAbsent: [^ self].
+ 	lastP _ state at: LastMouseIndex.
+ 	p _ evt cursorPoint.
+ 	p = lastP ifTrue: [^ self].
+ 
+ 	pen _ state at: PenIndex.
+ 	pen drawFrom: lastP - bounds origin to: p - bounds origin.
+ 	self invalidRect: (
+ 		((lastP min: p) - pen sourceForm extent) corner:
+ 		((lastP max: p) + pen sourceForm extent)).
+ 	state at: LastMouseIndex put: p.
+ !

Item was added:
+ ----- Method: MultiuserTinyPaint>>penSize:hand: (in category 'menu') -----
+ penSize: anInteger hand: hand
+ 
+ 	| state |
+ 	(drawState includesKey: hand) ifFalse: [self createDrawStateFor: hand].
+ 	state _ drawState at: hand.
+ 	state at: PenSizeIndex put: anInteger.
+ 	(state at: PenIndex) roundNib: anInteger.
+ !

Item was added:
+ ----- Method: MultiuserTinyPaint>>setPenColor: (in category 'menu') -----
+ setPenColor: evt
+ 	| state |
+ 	(drawState includesKey: evt hand) ifFalse: [self createDrawStateFor: evt hand].
+ 	state _ drawState at: evt hand.
+ 	self changeColorTarget: self selector: #brushColor:hand: originalColor: (state at: PenColorIndex) hand: evt hand!

Item was added:
+ ----- Method: MultiuserTinyPaint>>setPenSize: (in category 'menu') -----
+ setPenSize: evt
+ 
+ 	| menu sizes |
+ 	menu _ MenuMorph new.
+ 	sizes _ (0 to: 5), (6 to: 12 by: 2), (15 to: 40 by: 5).
+ 	sizes do: [:w |
+ 		menu add: w printString
+ 			target: self
+ 			selector: #penSize:hand:
+ 			argumentList: (Array with: w with: evt hand)].
+ 
+ 	menu popUpEvent: evt in: self world!

Item was added:
+ AppRegistry subclass: #MvcTextEditor
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Applications'!
+ 
+ !MvcTextEditor commentStamp: 'tween 8/27/2004 12:24' prior: 0!
+ A subclass of AppRegistry which allows the user, or Browser add-ons, to control which class is used when creating the code editing view in mvc Browsers!

Item was added:
+ BroomMorph subclass: #NCBroomMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-BroomMorphs-Connectors'!
+ 
+ !NCBroomMorph commentStamp: '<historical>' prior: 0!
+ This is a BroomMorph that won't move labels or connectors.!

Item was added:
+ ----- Method: NCBroomMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName: 	'Connector Broom' translatedNoop
+ 		categories:		{'Connectors' translatedNoop}
+ 		documentation:	'A broom to align shapes with' translatedNoop!

Item was added:
+ ----- Method: NCBroomMorph class>>newInHand (in category 'instance creation') -----
+ newInHand
+ 	self new openInHand!

Item was added:
+ ----- Method: NCBroomMorph>>basicClass (in category 'initialization') -----
+ basicClass
+ 	^NCBroomMorph!

Item was added:
+ ----- Method: NCBroomMorph>>resetFilter (in category 'initialization') -----
+ resetFilter
+ 
+ 	self filter: [ :m | m isConnector not and: [ m isConstraint not ] ].!

Item was added:
+ ----- Method: NaturalLanguageTranslator class>>availableLanguageLocaleIDs (in category '*Etoys-Squeakland-accessing') -----
+ availableLanguageLocaleIDs
+ 	"Return the locale ids for the currently available languages.  
+ 	Meaning those which either internally or externally have  
+ 	translations available."
+ 	"NaturalLanguageTranslator availableLanguageLocaleIDs"
+ 	^ self translators values collect:[:each | each localeID]!

Item was added:
+ ----- Method: NebraskaServer class>>defaultPorts (in category '*Etoys-Squeakland-as yet unclassified') -----
+ defaultPorts
+ 	^ 9091 to: 9099!

Item was added:
+ ----- Method: NebraskaServer>>listeningPort (in category '*Etoys-Squeakland-networking') -----
+ listeningPort
+ 	^listenQueue portNumberOrNil!

Item was added:
+ LanguageEnvironment subclass: #NepaleseEnvironment
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-Languages'!

Item was added:
+ ----- Method: NepaleseEnvironment class>>clipboardInterpreterClass (in category 'subclass responsibilities') -----
+ clipboardInterpreterClass
+ 
+ 	^ UTF8ClipboardInterpreter.
+ !

Item was added:
+ ----- Method: NepaleseEnvironment class>>fileNameConverterClass (in category 'subclass responsibilities') -----
+ fileNameConverterClass
+ 
+ 	^ UTF8TextConverter.
+ !

Item was added:
+ ----- Method: NepaleseEnvironment class>>inputInterpreterClass (in category 'subclass responsibilities') -----
+ inputInterpreterClass
+ 	| platformName osVersion |
+ 	platformName := SmalltalkImage current platformName.
+ 	osVersion := SmalltalkImage current getSystemAttribute: 1002.
+ 	(platformName = 'Win32'
+ 			and: [osVersion = 'CE'])
+ 		ifTrue: [^ MacRomanInputInterpreter].
+ 	platformName = 'Win32'
+ 		ifTrue: [^ UTF32NPInputInterpreter].
+ 	platformName = 'Mac OS'
+ 		ifTrue: [^ MacUnicodeInputInterpreter].
+ 	platformName = 'unix'
+ 		ifTrue: [^ UTF32NPInputInterpreter].
+ 	^ MacRomanInputInterpreter!

Item was added:
+ ----- Method: NepaleseEnvironment class>>leadingChar (in category 'subclass responsibilities') -----
+ leadingChar
+ 
+ 	^ 15.
+ !

Item was added:
+ ----- Method: NepaleseEnvironment class>>supportedLanguages (in category 'subclass responsibilities') -----
+ supportedLanguages
+ 	"Return the languages that this class supports. 
+ 	Any translations for those languages will use this class as their environment."
+ 	
+ 	^#('ne')!

Item was added:
+ ----- Method: NepaleseEnvironment class>>systemConverterClass (in category 'subclass responsibilities') -----
+ systemConverterClass
+ 
+ 	^ UTF8TextConverter.
+ !

Item was added:
+ GenericPropertiesMorph subclass: #NewVariableDialogMorph
+ 	instanceVariableNames: 'varNameText varTypeButton decimalPlacesButton'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Scripting'!

Item was added:
+ ----- Method: NewVariableDialogMorph class>>new (in category 'as yet unclassified') -----
+ new
+ 	^ self on: Morph new openInWorld!

Item was added:
+ ----- Method: NewVariableDialogMorph class>>on: (in category 'as yet unclassified') -----
+ on: morph
+ 	^ self basicNew initializeWith: morph!

Item was added:
+ ----- Method: NewVariableDialogMorph>>addArrowsOn: (in category 'build') -----
+ addArrowsOn: button
+ 	| arrowsHolder |
+ 	arrowsHolder := (TileMorph addArrowsOn: button) anyOne owner.
+ 	arrowsHolder center: button left + (arrowsHolder width / 2) + 2 @ button center y.
+ !

Item was added:
+ ----- Method: NewVariableDialogMorph>>addDecimalPlaces (in category 'build') -----
+ addDecimalPlaces
+ 	self addARow: {
+ 		self inAColumn: {
+ 			(self addARow: {
+ 				self lockedString: 'Decimal places:' translated.
+ 				self spacer.
+ 				decimalPlacesButton := self buildDecimalPlacesButton
+ 			} ) cellPositioning: #center.
+ 		} named: #decimalPlaces.
+ 	}.
+ 	self addSeparator!

Item was added:
+ ----- Method: NewVariableDialogMorph>>addNewVariable (in category 'actions') -----
+ addNewVariable
+ 	| slotName |
+ 	self targetPlayer 
+ 		addInstanceVariableNamed: (slotName := self varAcceptableName)
+ 		type: self varType
+ 		value: (self targetPlayer initialValueForSlotOfType: self varType).
+ 	(#(#Number #Point) includes: self varType)
+ 		ifTrue: [
+ 			self targetPlayer
+ 				setPrecisionFor: slotName
+ 				precision: self decimalPlaces]!

Item was added:
+ ----- Method: NewVariableDialogMorph>>addSeparator (in category 'build') -----
+ addSeparator
+ 	(self addAColumn: {})
+ 		wrapCentering: #topLeft;
+ 		color: Color white;
+ 		borderWidth: 2;
+ 		borderColor: self color darker.!

Item was added:
+ ----- Method: NewVariableDialogMorph>>askUserForDecimalPlaces (in category 'actions') -----
+ askUserForDecimalPlaces
+ 	| list |
+ 	list := #(0 1 2 3 4 5 6 7 8 9 10).
+ 	^ UIManager 
+ 		chooseFrom: (list collect: [:each | each asString])
+ 		values: list
+ 		title: ('How many decimal places? (currently {1})' translated
+ 						format: {self decimalPlaces})!

Item was added:
+ ----- Method: NewVariableDialogMorph>>askUserForNewType (in category 'actions') -----
+ askUserForNewType
+ 	"Put up a pop up offering the user a choice of valid types for user-defined variables."
+ 
+ 	| typeChoices menuTitle |
+ 	typeChoices := Vocabulary typeChoicesForUserVariables.
+ 	menuTitle := 'Choose the TYPE
+ for {1}
+ ' translated, '
+ (currently {2})' translated format: {self varAcceptableName. self varType}.
+ 	^ UIManager default
+ 		chooseFrom: (typeChoices collect: [:t | t translated])
+ 		values: typeChoices
+ 		title: menuTitle!

Item was added:
+ ----- Method: NewVariableDialogMorph>>buildDecimalPlacesButton (in category 'build') -----
+ buildDecimalPlacesButton
+ 	| button |
+ 	button := SimpleButtonMorph new					
+ 		labelString: self decimalPlaces asString font: Preferences standardEToysButtonFont;
+ 		color: (Color r: 0.806 g: 1.0 b: 0.645);
+ 		target: self;
+ 		actionSelector: #chooseDecimalPlaces;
+ 		extent: 200 @ (TextStyle defaultFont height + 10);
+ 		cornerStyle: #square;
+ 		borderColor: #raised;
+ 		yourself.
+ 	self addArrowsOn: button.
+ 	^ button
+ 	!

Item was added:
+ ----- Method: NewVariableDialogMorph>>buildVarTypeButton (in category 'build') -----
+ buildVarTypeButton
+ 	| button |
+ 	button := SimpleButtonMorph new					
+ 		labelString: self varType translated font: Preferences standardEToysButtonFont;
+ 		color: (Color r: 0.806 g: 1.0 b: 0.645);
+ 		target: self;
+ 		actionSelector: #chooseType;
+ 		extent: 200 @ (TextStyle defaultFont height + 10);
+ 		cornerStyle: #square;
+ 		borderColor: #raised;
+ 		yourself.
+ 	self addArrowsOn: button.
+ 	^ button
+ 	!

Item was added:
+ ----- Method: NewVariableDialogMorph>>chooseDecimalPlaces (in category 'actions') -----
+ chooseDecimalPlaces
+ 	self askUserForDecimalPlaces 
+ 		ifNotNil: [:reply |
+ 			decimalPlacesButton label: reply asString.
+ 			self rebuild]!

Item was added:
+ ----- Method: NewVariableDialogMorph>>chooseType (in category 'actions') -----
+ chooseType
+ 	self askUserForNewType
+ 		ifNotNil: [:newType |
+ 			varTypeButton label: newType.
+ 			self rebuild]!

Item was added:
+ ----- Method: NewVariableDialogMorph>>decimalPlaces (in category 'accessing') -----
+ decimalPlaces
+ 	^ decimalPlacesButton
+ 		ifNil: [Utilities 
+ 				decimalPlacesForFloatPrecision: (self targetPlayer
+ 					defaultFloatPrecisionFor: (Utilities getterSelectorFor: self varAcceptableName))]
+ 		ifNotNil: [:button| button label asNumber]!

Item was added:
+ ----- Method: NewVariableDialogMorph>>defaultBorderColor (in category 'accessing') -----
+ defaultBorderColor
+ 	^ self defaultColor darker!

Item was added:
+ ----- Method: NewVariableDialogMorph>>defaultColor (in category 'accessing') -----
+ defaultColor
+ 	^ (Color r: 0.677 g: 0.935 b: 0.484) 
+ 			mixed: 0.9 with: Color blue!

Item was added:
+ ----- Method: NewVariableDialogMorph>>doAccept (in category 'actions') -----
+ doAccept
+ 	self delete.
+ 	self varName isEmpty ifTrue: [^ self].
+ 	self addNewVariable!

Item was added:
+ ----- Method: NewVariableDialogMorph>>initialize (in category 'initialize') -----
+ initialize
+ 	super initialize.
+ 	self rebuild!

Item was added:
+ ----- Method: NewVariableDialogMorph>>initializeWith: (in category 'initialize') -----
+ initializeWith: aMorph
+ 	myTarget := aMorph.
+ 	self initialize!

Item was added:
+ ----- Method: NewVariableDialogMorph>>morphicLayerNumber (in category 'accessing') -----
+ morphicLayerNumber
+ 
+ 	^10.6!

Item was added:
+ ----- Method: NewVariableDialogMorph>>newTextMorph (in category 'build') -----
+ newTextMorph
+ 	^ TextMorph new autoFit: false;
+ 		 extent: 200 @ (TextStyle defaultFont height + 6);
+ 		 borderWidth: 1;
+ 		 backgroundColor: Color white;
+ 		 borderColor: Color gray;
+ 		 centered!

Item was added:
+ ----- Method: NewVariableDialogMorph>>rebuild (in category 'build') -----
+ rebuild
+ 	| buttonColor itsName enableDecimalPlaces |
+ 	self removeAllMorphs.
+ 	self addAColumn: {
+ 		self lockedString: self title.
+ 	}.
+ 	self addSeparator.
+ 
+ 	self addARow: {
+ 		self inAColumn: {
+ 			(self addARow: {
+ 				self lockedString: 'Name:' translated.
+ 				self spacer.
+ 				varNameText := self newTextMorph 
+ 										contentsWrapped: self varName;
+ 										selectAll;
+ 										crAction: (MessageSend
+ 											receiver: self
+ 											selector: #doAccept);
+ 										yourself
+ 			}) cellPositioning: #center.
+ 			self inAColumn: {
+ 								(self addARow: {
+ 									self lockedString: 'Type:' translated.
+ 									self spacer.
+ 									varTypeButton := self buildVarTypeButton
+ 								}) cellPositioning: #center.
+ 								} named: #varType.
+ 		}
+ 	}.
+ 	ActiveWorld activeHand newKeyboardFocus: varNameText.
+ 	self addSeparator.
+ 	self addDecimalPlaces.
+ 	enableDecimalPlaces := false.
+ 	(#(#Number #Point) includes: self varType)
+ 		ifTrue: [ enableDecimalPlaces := true].
+ 	self allMorphsDo: [ :each |
+ 				itsName := each knownName. 
+ 				(#(decimalPlaces) includes: itsName) ifTrue:
+ 							[self enable: each when: enableDecimalPlaces]].
+ 
+ 	
+ 
+ 
+ 	buttonColor := self color lighter.
+ 	self addARow: {
+ 		self inAColumn: {
+ 			(self addARow: {
+ 				self 
+ 					buttonNamed: 'Accept' translated action: #doAccept color: buttonColor
+ 					help: 'keep changes made and close panel' translated.
+ 				self 
+ 					buttonNamed: 'Cancel' translated action: #doCancel color: buttonColor
+ 					help: 'cancel changes made and close panel' translated.
+ 			}) listCentering: #center
+ 		}
+ 	}
+ !

Item was added:
+ ----- Method: NewVariableDialogMorph>>spacer (in category 'build') -----
+ spacer
+ 	^ AlignmentMorph newVariableTransparentSpacer !

Item was added:
+ ----- Method: NewVariableDialogMorph>>target (in category 'accessing') -----
+ target
+ 	^ myTarget!

Item was added:
+ ----- Method: NewVariableDialogMorph>>targetPlayer (in category 'accessing') -----
+ targetPlayer
+ 	^ self target assuredPlayer!

Item was added:
+ ----- Method: NewVariableDialogMorph>>title (in category 'accessing') -----
+ title
+ 	^ 'Add new variable' translated!

Item was added:
+ ----- Method: NewVariableDialogMorph>>varAcceptableName (in category 'accessing') -----
+ varAcceptableName
+ 	^ ScriptingSystem
+ 		acceptableSlotNameFrom: self varName
+ 		forSlotCurrentlyNamed: nil
+ 		asSlotNameIn: self targetPlayer
+ 		world: self targetPlayer costume world!

Item was added:
+ ----- Method: NewVariableDialogMorph>>varName (in category 'accessing') -----
+ varName
+ 	^ varNameText
+ 		ifNil: [| usedNames |
+ 			usedNames := self targetPlayer class instVarNames.
+ 			Utilities
+ 				keyLike: ('var' translated, (usedNames size + 1) asString)
+ 				satisfying: [:aKey | (usedNames includes: aKey) not]]
+ 		ifNotNil: [:text | text contents string]!

Item was added:
+ ----- Method: NewVariableDialogMorph>>varType (in category 'accessing') -----
+ varType
+ 	"Answer the symbol representing the chosen value type for the variable."
+ 
+ 	^ varTypeButton
+ 		ifNil: [self targetPlayer initialTypeForSlotNamed: self varAcceptableName]
+ 		ifNotNil: [:button| 
+ 			Vocabulary typeChoicesForUserVariables
+ 				detect: [:each |
+ 					each translated = button label]
+ 				ifNone: [button label asSymbol]]!

Item was added:
+ SystemWindow subclass: #NewWorldWindow
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Windows'!

Item was added:
+ ----- Method: NewWorldWindow>>addMorph:frame: (in category 'panes') -----
+ addMorph: aMorph frame: relFrame
+ 	| cc |
+ 	cc _ aMorph color.
+ 	super addMorph: aMorph frame: relFrame.
+ 	aMorph color: cc.!

Item was added:
+ ----- Method: NewWorldWindow>>amendSteppingStatus (in category 'stepping') -----
+ amendSteppingStatus!

Item was added:
+ ----- Method: NewWorldWindow>>openInWorld: (in category 'initialization') -----
+ openInWorld: aWorld
+ 	| xxx |
+ 	"This msg and its callees result in the window being activeOnlyOnTop"
+ 
+ 	xxx _ RealEstateAgent initialFrameFor: self world: aWorld.
+ 
+ 	"Bob say: 'opening in ',xxx printString,' out of ',aWorld bounds printString.
+ 	6 timesRepeat: [Display flash: xxx andWait: 300]."
+ 
+ 	self bounds: xxx.
+ 	^self openAsIsIn: aWorld.!

Item was added:
+ ----- Method: NewWorldWindow>>setStripeColorsFrom: (in category 'label') -----
+ setStripeColorsFrom: paneColor
+ 	"Since our world may be *any* color, try to avoid really dark colors so title will show"
+ 
+ 	| revisedColor |
+ 	stripes ifNil: [^ self].
+ 	revisedColor _ paneColor atLeastAsLuminentAs: 0.1 .
+ 	self isActive ifTrue:
+ 		[stripes second 
+ 			color: revisedColor; 
+ 			borderColor: stripes second color darker.
+ 		stripes first 
+ 			color: stripes second borderColor darker;
+ 			borderColor: stripes first color darker.
+ 		^ self].
+ 	"This could be much faster"
+ 	stripes second 
+ 		color: revisedColor; 
+ 		borderColor: revisedColor.
+ 	stripes first 
+ 		color: revisedColor; 
+ 		borderColor: revisedColor!

Item was added:
+ ----- Method: NewWorldWindow>>setWindowColor: (in category 'color') -----
+ setWindowColor: incomingColor
+ 	| existingColor aColor |
+ 
+ 	incomingColor ifNil: [^ self].  "it happens"
+ 	aColor _ incomingColor asNontranslucentColor.
+ 	(aColor = ColorPickerMorph perniciousBorderColor 
+ 		or: [aColor = Color black]) ifTrue: [^ self].
+ 	existingColor _ self paneColorToUse.
+ 	existingColor ifNil: [^ Beeper beep].
+ 	self setStripeColorsFrom: aColor
+ 		
+ !

Item was added:
+ ----- Method: NewWorldWindow>>spawnReframeHandle: (in category 'resize/collapse') -----
+ spawnReframeHandle: event
+ 	"The mouse has crossed a pane border.  Spawn a reframe handle."
+ 	| resizer localPt pt ptName newBounds |
+ 
+ 	allowReframeHandles ifFalse: [^ self].
+ 	owner ifNil: [^ self  "Spurious mouseLeave due to delete"].
+ 	(self isActive not or: [self isCollapsed]) ifTrue:  [^ self].
+ 	((self world ifNil: [^ self]) firstSubmorph isKindOf: NewHandleMorph) ifTrue:
+ 		[^ self  "Prevent multiple handles"].
+ 
+ "Transcript show: event hand printString,'  ',event hand world printString,
+ 		'  ',self world printString,' ',self outermostWorldMorph printString; cr; cr."
+ 	pt _ event cursorPoint.
+ 	self bounds forPoint: pt closestSideDistLen:
+ 		[:side :dist :len |  "Check for window side adjust"
+ 		dist <= 2  ifTrue: [ptName _ side]].
+ 	ptName ifNil:
+ 		["Check for pane border adjust"
+ 		^ self spawnPaneFrameHandle: event].
+ 	#(topLeft bottomRight bottomLeft topRight) do:
+ 		[:corner |  "Check for window corner adjust"
+ 		(pt dist: (self bounds perform: corner)) < 20 ifTrue: [ptName _ corner]].
+ 
+ 	resizer _ NewHandleMorph new
+ 		followHand: event hand
+ 		forEachPointDo:
+ 			[:p | localPt _ self pointFromWorld: p.
+ 			newBounds _ self bounds
+ 				withSideOrCorner: ptName
+ 				setToPoint: localPt
+ 				minExtent: self minimumExtent.
+ 			self fastFramingOn 
+ 			ifTrue:
+ 				[self doFastWindowReframe: ptName]
+ 			ifFalse:
+ 				[self bounds: newBounds.
+ 				(Preferences roundedWindowCorners
+ 					and: [#(bottom right bottomRight) includes: ptName])
+ 					ifTrue:
+ 					["Complete kluge: causes rounded corners to get painted correctly,
+ 					in spite of not working with top-down displayWorld."
+ 					ptName = #bottom ifFalse:
+ 						[self invalidRect: (self bounds topRight - (6 at 0) extent: 7 at 7)].
+ 					ptName = #right ifFalse:
+ 						[self invalidRect: (self bounds bottomLeft - (0 at 6) extent: 7 at 7)].
+ 					self invalidRect: (self bounds bottomRight - (6 at 6) extent: 7 at 7)]]]
+ 		lastPointDo:
+ 			[:p | ].
+ 	self world addMorph: resizer.
+ 	resizer startStepping.
+ !

Item was added:
+ ----- Method: NewWorldWindow>>updatePaneColors (in category 'panes') -----
+ updatePaneColors
+ 	"Useful when changing from monochrome to color display"
+ 
+ 	self setStripeColorsFrom: self paneColorToUse.
+ 
+ 	"paneMorphs do: [:p | p color: self paneColorToUse]."	"since pane is a world, skip this"
+ !

Item was added:
+ ----- Method: NewWorldWindow>>wantsSteps (in category 'testing') -----
+ wantsSteps
+ 	
+ 	^true!

Item was added:
+ Morph subclass: #NoHaloMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sugar'!

Item was added:
+ ----- Method: NoHaloMorph class>>inARow: (in category 'instance creation') -----
+ inARow: aCollectionOfMorphs
+ 	"Answer an instance of the receiver, a row morph, with the given collection as its submorphs, and transparent in color.  Interpret the symbol #spacer in the incoming list as a request for a variable transparent spacer."
+ 
+ 	| row |
+ 	row _ self new.
+ 	row layoutPolicy: TableLayout new.
+ 	row
+ 		listDirection: #leftToRight;
+ 		vResizing: #shrinkWrap;
+ 		hResizing: #spaceFill;
+ 		layoutInset: 0;
+ 		cellPositioning: #center;
+ 		borderWidth: 0;
+ 		color: Color transparent.
+ 	aCollectionOfMorphs do:
+ 		[ :each |  | toAdd |
+ 			toAdd := each == #spacer
+ 				ifTrue:
+ 					[AlignmentMorph newVariableTransparentSpacer]
+ 				ifFalse:
+ 					[each].
+ 			row addMorphBack: toAdd].
+ 	^ row
+ !

Item was added:
+ ----- Method: NoHaloMorph>>wantsHaloFromClick (in category 'as yet unclassified') -----
+ wantsHaloFromClick
+ 
+ 	^ false.
+ !

Item was added:
+ ----- Method: Number class>>readEToyNumberFrom: (in category '*Etoys-Squeakland-instance creation') -----
+ readEToyNumberFrom: aString 
+ 	"Answer a number as described in the string"
+ 
+ 	| value aStream sign |
+ 	aStream := ReadStream on: (aString copyWithout: $ ).
+ 	(aStream nextMatchAll: 'NaN') ifTrue: [^ Float nan].
+ 
+ 	sign _ (aStream peekFor: $-) ifTrue: [-1] ifFalse: [1].
+ 
+ 	(aStream peekFor: $.) ifTrue: "Don't gag on leading decimal point without whole-number part"
+ 		[sign = 1
+ 			ifTrue: "leading decimal point"
+ 				[^ self readEToyNumberFrom: '0', aString]
+ 			ifFalse:  "minus-sign followed by a decimal point"
+ 				[^ self readEToyNumberFrom: '-0', aString allButFirst]].
+ 
+ 	(aStream nextMatchAll: 'Infinity') ifTrue: [^ Float infinity * sign].
+ 
+ 	value _ [Integer readFrom: aStream base: 10] ifError:
+ 		[self inform: aString, ' is not a number;
+ please correct and try again' translated.
+ 		^ nil].
+ 
+ 	^ self readRemainderOf: value from: aStream base: 10 withSign: sign!

Item was added:
+ ----- Method: Number>>cubeRoot (in category '*Etoys-Squeakland-mathematical functions') -----
+ cubeRoot
+ 	"Answer the cube root of the receiver."
+ 
+ 	^ self asFloat cubeRoot!

Item was added:
+ ----- Method: Number>>cubed (in category '*Etoys-Squeakland-mathematical functions') -----
+ cubed
+ 	"Answer the cube of the receiver."
+ 
+ 	^ self * self * self!

Item was added:
+ ----- Method: Number>>degreeArcTan (in category '*Etoys-Squeakland-mathematical functions') -----
+ degreeArcTan
+ 	"The receiver is the tangent of an angle. Answer the angle measured in degrees."
+ 
+ 	^ self asFloat degreeArcTan!

Item was added:
+ ----- Method: Number>>degreeTan (in category '*Etoys-Squeakland-mathematical functions') -----
+ degreeTan
+ 	"Answer the tangent of the receiver taken as an angle in degrees."
+ 	
+ 	^ self asFloat degreeTan!

Item was added:
+ ----- Method: Number>>factorial (in category '*Etoys-Squeakland-mathematical functions') -----
+ factorial
+ 	"Answer the factorial of the receiver."
+ 
+ 	^ self truncated factorial!

Item was added:
+ ----- Method: Number>>grouped (in category '*Etoys-Squeakland-arithmetic') -----
+ grouped
+ 	"Sent as a pseudo-function for parenthesizing in tile scripts."
+ 
+ 	^ self!

Item was added:
+ ----- Method: Number>>random (in category '*Etoys-Squeakland-truncation and round off') -----
+ random
+ 	"Answer a random integer between 1 and the receiver."
+ 
+ 	^ self asInteger atRandom!

Item was added:
+ ----- Method: Number>>safeFactorial (in category '*Etoys-Squeakland-mathematical functions') -----
+ safeFactorial
+ 	"Answer the factorial of the receiver."
+ 
+ 	^ self truncated safeFactorial!

Item was added:
+ ----- Method: Number>>safeLn (in category '*Etoys-Squeakland-mathematical functions') -----
+ safeLn
+ 	"Answer the natural logarithm of the receiver, safely"
+ 
+ 	 ^ self asFloat safeLn!

Item was added:
+ ----- Method: Number>>safeLog (in category '*Etoys-Squeakland-mathematical functions') -----
+ safeLog
+ 	"Answer the base-10 log of the receiver, safely"
+ 
+ 	 ^ self asFloat safeLog!

Item was added:
+ ----- Method: Number>>safeSquareRoot (in category '*Etoys-Squeakland-mathematical functions') -----
+ safeSquareRoot
+ 	"Answer the square root of the receiver.   If the receiver is negative, answer zero and swallow the error."
+ 
+ 	^ self asFloat safeSquareRoot!

Item was added:
+ ----- Method: Number>>timesRepeat: (in category '*Etoys-Squeakland-enumerating') -----
+ timesRepeat: aBlock 
+ 	"Evaluate the argument, aBlock, the number of times represented by the 
+ 	receiver."
+ 
+ 	^ self asInteger timesRepeat: aBlock!

Item was added:
+ Morph subclass: #NumberLineMorph
+ 	instanceVariableNames: 'minValue actualColor axis showZero pixelsPerUnit unitsPerMark marksPerLegend'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-MorphicExtras-Charts'!
+ 
+ !NumberLineMorph commentStamp: 'sw 3/4/2012 00:20' prior: 0!
+ An abstract superclass for VerticalNumberLine and HorizontalNumberLine.
+ 
+ minValue - Number - the value corresponding to the left edge of the line.
+ pixelsPerUnit - Integer - the number of pixels on the graph that correspond to a single unit in the metric space of the line.
+ actualColor - the color borne by the axis
+ axis - a two-vertex PolygonMorph which is the actual line
+ showZero - Boolean - if false, then a 0 legend will *not* be show.!

Item was added:
+ ----- Method: NumberLineMorph class>>additionsToViewerCategoryNumberLine (in category 'viewer categories') -----
+ additionsToViewerCategoryNumberLine
+ 	^ #('number line' (
+ 	"	(command fitPlayfield 'extend or contract such that the line fits within the containing playfield.')"
+ 		(slot minVal 'smallest value shown on the axis' Number readWrite Player getMinVal Player setMinVal:)
+ 		(slot maxVal 'largest value shown on the axis' Number readWrite Player getMaxVal Player setMaxVal:)
+ 
+ 		(slot pixelsPerUnit 'number of screen pixels per unit on the number line' Number readWrite Player getPixelsPerUnit Player setPixelsPerUnit:)
+ 		(slot unitsPerMark 'number of units between tick marks on the number line' Number readWrite Player getUnitsPerMark Player setUnitsPerMark:)
+ 		(slot marksPerLegend 'number of ticks between successive legends' Number readWrite Player getMarksPerLegend Player setMarksPerLegend:)
+ 
+ 		(slot showZero 'whether to show the numeral 0 at the zero point on this axis' Boolean readWrite Player getShowZero Player setShowZero:)
+ 		(slot showNegativeArrowHead 'whether to show an arrow-head at the extreme lower end of the axis' Boolean readWrite Player getShowNegativeArrowHead Player setShowNegativeArrowHead:)) )!

Item was added:
+ ----- Method: NumberLineMorph class>>from:pixelsPerUnit:unitsPerMark:marksPerLegend: (in category 'instance creation') -----
+ from: minValue pixelsPerUnit: pixelsPerUnit  unitsPerMark: unitsPerMark marksPerLegend: marksPerLegend
+ 
+ 	^ (self new
+ 			minValue: minValue pixelsPerUnit: pixelsPerUnit unitsPerMark: unitsPerMark marksPerLegend: marksPerLegend)!

Item was added:
+ ----- Method: NumberLineMorph class>>newStandAlone (in category 'instance creation') -----
+ newStandAlone
+ 
+ 	^ (self from: -10 pixelsPerUnit: 30 unitsPerMark: 1 marksPerLegend: 1) update; yourself!

Item was added:
+ ----- Method: NumberLineMorph>>addCustomMenuItems:hand: (in category 'halo menu') -----
+ addCustomMenuItems: aMenu hand: aHandMorph
+ 	"Use my line's menu additions"
+ 	super addCustomMenuItems: aMenu hand: aHandMorph.
+ 	aMenu addLine.
+ 
+ 	aMenu addList: {
+ 		{'set pixels per unit' translated. 			#choosePixelsPerUnit.			'set the number of pixels per unit on the number line.' translated}.
+ 		{'set units per mark' translated.	#chooseUnitsPerMark.	'set the number of units between marks on the number line.' translated}.
+ 		{'set marks per legend' translated.	#chooseMarksPerLegend.	'set the number of units between tick marks on the number line.' translated}.
+ 
+ 		{'set max value' translated.	#chooseMaxValue. 	'set the maximum value to be shown on the number line.' translated}.
+ 		{'set min value' translated . 	#chooseMinValue.		'set the minimum value shown on the number line.' translated}}.
+ 
+ 	aMenu
+ 		addUpdating: #showingNegativeArrowHeadPhrase target: self action: #toggleNegativeArrowHead;
+ 		addUpdating: #showingZeroPhrase target: self action: #toggleShowingZero..
+ 
+ !

Item was added:
+ ----- Method: NumberLineMorph>>allowance (in category 'visual properties') -----
+ allowance
+ 	"Answer the allowance for overhead -- put here to avoid hard-coding the number in multiple other places..."
+ 
+ 	^ 50!

Item was added:
+ ----- Method: NumberLineMorph>>asValidExtent: (in category 'abstract') -----
+ asValidExtent: newExtent 
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: NumberLineMorph>>centerOfAxisVertex: (in category 'abstract') -----
+ centerOfAxisVertex: n 
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: NumberLineMorph>>chooseMarksPerLegend (in category 'halo menu') -----
+ chooseMarksPerLegend
+ 	"Put up a dialog disclosing the current increment and inviting the user to specify a new one."
+ 
+ 	| result |
+ 	result := FillInTheBlank request: 'marksPerLegend' translated initialAnswer: self marksPerLegend printString.
+ 	result isEmptyOrNil ifTrue: [^ self].
+ 	self marksPerLegend: result asNumber
+ !

Item was added:
+ ----- Method: NumberLineMorph>>chooseMaxValue (in category 'halo menu') -----
+ chooseMaxValue
+ 	"Put up a dialog showing the current maxValue and inviting the user to specify a new one."
+ 
+ 	| result |
+ 	result := FillInTheBlank request: 'type new max value' initialAnswer: self maxValue printString.
+ 	result isEmptyOrNil ifTrue: [^ self].
+ 	self maxValue: result asNumber
+ !

Item was added:
+ ----- Method: NumberLineMorph>>chooseMinValue (in category 'halo menu') -----
+ chooseMinValue
+ 	"Put up a dialog disclosing the current minValue and allowing the user to specify a new value for it."
+ 
+ 	| result |
+ 	result := FillInTheBlank request: 'type new min value' initialAnswer: self minValue printString.
+ 	result isEmptyOrNil ifTrue: [^ self].
+ 	self minValue: result asNumber
+ !

Item was added:
+ ----- Method: NumberLineMorph>>choosePixelsPerUnit (in category 'halo menu') -----
+ choosePixelsPerUnit
+ 	"Put up a dialog showing the current pixelsPerUnit and allowing the user to submit a new one."
+ 
+ 	| result |
+ 	result := FillInTheBlank request: 'type new pixels per unit' translated initialAnswer: pixelsPerUnit printString.
+ 	result isEmptyOrNil ifTrue: [^ self].
+ 	self pixelsPerUnit: result asNumber!

Item was added:
+ ----- Method: NumberLineMorph>>chooseUnitsPerMark (in category 'menu') -----
+ chooseUnitsPerMark
+ 	"Put up a dialog disclosing the current unitsPerMark and inviting the user to specify a new one."
+ 
+ 	| result |
+ 	result := FillInTheBlank request: 'unitsPerMark' translated initialAnswer: self unitsPerMark printString.
+ 	result isEmptyOrNil ifTrue: [^ self].
+ 	self unitsPerMark: result asNumber
+ !

Item was added:
+ ----- Method: NumberLineMorph>>color (in category 'accessing') -----
+ color
+ 	^ actualColor!

Item was added:
+ ----- Method: NumberLineMorph>>color: (in category 'accessing') -----
+ color: aColor 
+ 	actualColor := aColor.
+ 	super color: Color transparent.
+ 	self update!

Item was added:
+ ----- Method: NumberLineMorph>>extent: (in category 'accessing') -----
+ extent: newExtent 
+ 	super
+ 		extent: (self asValidExtent: newExtent).
+ 	self update!

Item was added:
+ ----- Method: NumberLineMorph>>fillStyle: (in category 'accessing') -----
+ fillStyle: aFillStyle 
+ 	self color: aFillStyle asColor!

Item was added:
+ ----- Method: NumberLineMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"Basic initialization."
+ 
+ 	super initialize.
+ 	actualColor := Color black.
+ 	axis := PolygonMorph arrowPrototype arrowSpec: 8 @ 4;
+ 				 lineBorderWidth: 1.
+ 	pixelsPerUnit := 40.
+ 	unitsPerMark := 5.
+ 	marksPerLegend := 1.
+ 	showZero := true.
+ 	minValue := 0.
+ 	self addMorph: axis;
+ 		 color: actualColor.
+ 	self update!

Item was added:
+ ----- Method: NumberLineMorph>>legendsHeight (in category 'accessing') -----
+ legendsHeight
+ 	^ TextStyle defaultFont height!

Item was added:
+ ----- Method: NumberLineMorph>>legendsWidth (in category 'accessing') -----
+ legendsWidth
+ 	^ (self widthOfString: self minValue asString)
+ 		max: (self widthOfString: self maxValue asString)!

Item was added:
+ ----- Method: NumberLineMorph>>marksHeight (in category 'accessing') -----
+ marksHeight
+ 	^ 5!

Item was added:
+ ----- Method: NumberLineMorph>>marksPerLegend (in category 'accessing') -----
+ marksPerLegend
+ 	"Answer the value of marksPerLegend."
+ 
+ 	^ marksPerLegend!

Item was added:
+ ----- Method: NumberLineMorph>>marksPerLegend: (in category 'halo menu') -----
+ marksPerLegend: aNumber
+ 	"Set the value of marksPerLegend."
+ 
+ 	marksPerLegend := aNumber rounded max: 1.
+ 	self update!

Item was added:
+ ----- Method: NumberLineMorph>>marksWidth (in category 'accessing') -----
+ marksWidth
+ 	^ 5!

Item was added:
+ ----- Method: NumberLineMorph>>maxVal (in category 'accessing') -----
+ maxVal
+ 	^ self maxValue!

Item was added:
+ ----- Method: NumberLineMorph>>maxValue (in category 'accessing') -----
+ maxValue
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: NumberLineMorph>>minVal (in category 'accessing') -----
+ minVal
+ 	^ self minValue!

Item was added:
+ ----- Method: NumberLineMorph>>minValue (in category 'accessing') -----
+ minValue
+ 	^ minValue!

Item was added:
+ ----- Method: NumberLineMorph>>minValue: (in category 'accessing') -----
+ minValue: aNumber 
+ 	minValue := aNumber.
+ 	self update!

Item was added:
+ ----- Method: NumberLineMorph>>minValue:pixelsPerUnit:unitsPerMark:marksPerLegend: (in category 'initialization') -----
+ minValue: minInteger pixelsPerUnit: ppuInteger unitsPerMark: upmInteger marksPerLegend: mplInteger 
+ 	"Initialize the receiver to have the given minimum value, pixelsPerUnit, unitsPerMark, and marksPerLegend"
+ 
+ 	minValue := minInteger.
+ 	pixelsPerUnit := ppuInteger.
+ 	unitsPerMark := upmInteger.
+ 	marksPerLegend := mplInteger!

Item was added:
+ ----- Method: NumberLineMorph>>newMark (in category 'abstract') -----
+ newMark
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: NumberLineMorph>>offset (in category 'visual properties') -----
+ offset
+ 	^ 25!

Item was added:
+ ----- Method: NumberLineMorph>>pixelsPerUnit (in category 'accessing') -----
+ pixelsPerUnit
+ 	"Answer the number of pixels per unit in the receiver's metric system."
+ 
+ 	^ pixelsPerUnit!

Item was added:
+ ----- Method: NumberLineMorph>>pixelsPerUnit: (in category 'accessing') -----
+ pixelsPerUnit: aNumber
+ 	"Set the number of pixels that will constitute one 'unit' along the receiver.  Retain existing min and max values."
+ 
+ 	| newPixelsPerUnit existingMax |
+ 	(newPixelsPerUnit := aNumber max: 1) = pixelsPerUnit
+ 		ifTrue: [^ self].
+ 
+ 	self retainCenterAcross:
+ 		[existingMax := self maxValue.
+ 		pixelsPerUnit := newPixelsPerUnit.
+ 		self update.
+ 		self maxValue: existingMax]!

Item was added:
+ ----- Method: NumberLineMorph>>placeAxis (in category 'updating') -----
+ placeAxis
+ 	1
+ 		to: 2
+ 		do: [:i | axis vertices
+ 				at: i
+ 				put: (self centerOfAxisVertex: i)].
+ 	axis borderColor: self color.
+ 	axis computeBounds!

Item was added:
+ ----- Method: NumberLineMorph>>retainCenterAcross: (in category 'coordinates') -----
+ retainCenterAcross: aBlock
+ 	"The scale of the receiver is being changed..."
+ 
+ 	| oldCenter |
+ 	oldCenter := self center.
+ 	aBlock value.
+ 	self center: oldCenter!

Item was added:
+ ----- Method: NumberLineMorph>>setMaxVal: (in category 'accessing') -----
+ setMaxVal: aNumber 
+ 	self maxValue: aNumber!

Item was added:
+ ----- Method: NumberLineMorph>>setMinVal: (in category 'accessing') -----
+ setMinVal: aNumber 
+ 	self minValue: aNumber!

Item was added:
+ ----- Method: NumberLineMorph>>showNegativeArrowHead (in category 'accessing') -----
+ showNegativeArrowHead
+ 	^ axis arrows = #both!

Item was added:
+ ----- Method: NumberLineMorph>>showNegativeArrowHead: (in category 'accessing') -----
+ showNegativeArrowHead: aBoolean 
+ 	aBoolean
+ 		ifTrue: [axis makeBothArrows]
+ 		ifFalse: [axis makeForwardArrow]!

Item was added:
+ ----- Method: NumberLineMorph>>showZero (in category 'accessing') -----
+ showZero
+ 	^ showZero!

Item was added:
+ ----- Method: NumberLineMorph>>showZero: (in category 'accessing') -----
+ showZero: aBoolean 
+ 	showZero := aBoolean.
+ 	self update!

Item was added:
+ ----- Method: NumberLineMorph>>showingNegativeArrowHeadPhrase (in category 'halo menu') -----
+ showingNegativeArrowHeadPhrase
+ 	"Answer a phrase representing whether or not the receiver is currently showing an arrowhead at its negative end."
+ 
+ 	^ (self showNegativeArrowHead ifTrue: ['<yes>'] ifFalse: ['<no>']), 'show negative arrowhead' translated!

Item was added:
+ ----- Method: NumberLineMorph>>showingZeroPhrase (in category 'halo menu') -----
+ showingZeroPhrase
+ 	"Answer a phrase telling whether or not the legend for the zero-point should be shown on the axis."
+ 
+ 	^ (showZero ifTrue: ['<yes>'] ifFalse: ['<no>']), 'show legend for the zero point.' translated!

Item was added:
+ ----- Method: NumberLineMorph>>toggleNegativeArrowHead (in category 'halo menu') -----
+ toggleNegativeArrowHead
+ 	"Toggle the setting of the flag governing whether the negative-direction arrowhead should be shown."
+ 
+ 	self showNegativeArrowHead: self showNegativeArrowHead not!

Item was added:
+ ----- Method: NumberLineMorph>>toggleShowingZero (in category 'halo menu') -----
+ toggleShowingZero
+ 	"Toggle the setting of the flag that governs whether the zero-point legend should be shown."
+ 
+ 	self showZero: self showZero not!

Item was added:
+ ----- Method: NumberLineMorph>>unitsPerMark (in category 'accessing') -----
+ unitsPerMark
+ 	^ unitsPerMark!

Item was added:
+ ----- Method: NumberLineMorph>>unitsPerMark: (in category 'accessing') -----
+ unitsPerMark: anInteger
+ 	unitsPerMark := anInteger.
+ 	self update!

Item was added:
+ ----- Method: NumberLineMorph>>update (in category 'updating') -----
+ update
+ 	minValue ifNotNil:
+ 		[self placeAxis; addLegendsAndMarks]!

Item was added:
+ ----- Method: NumberLineMorph>>widthOfString: (in category 'accessing') -----
+ widthOfString: aString 
+ 	^ TextStyle defaultFont widthOfString: aString!

Item was added:
+ ----- Method: NumberType>>argumentTileForValue: (in category '*Etoys-Squeakland-tiles') -----
+ argumentTileForValue: aNumber
+ 	"Answer a tile to represent the type"
+ 
+ 	^ aNumber newTileMorphRepresentative typeColor: self typeColor!

Item was changed:
  ----- Method: NumberType>>defaultArgumentTile (in category '*Etoys-tiles') -----
  defaultArgumentTile
  	"Answer a tile to represent the type"
  
+ 	^ self argumentTileForValue: 5.
+ !
- 	^ 5 newTileMorphRepresentative typeColor: self typeColor!

Item was changed:
  ----- Method: NumericReadoutTile class>>supplementaryPartsDescriptions (in category 'instance creation') -----
  supplementaryPartsDescriptions
  	"Answer additional items for the parts bin"
  
  	Preferences universalTiles ifFalse: [^ #()].
  
  	^ {DescriptionForPartsBin
+ 		formalName: 'Number (fancy)' translatedNoop
+ 		categoryList: {'Basic' translatedNoop}
+ 		documentation: 'A number readout for a Stack.  Shows current value.  Click and type the value.  Shift-click on title to edit.' translatedNoop
- 		formalName: 'Number (fancy)'
- 		categoryList: #('Basic')
- 		documentation: 'A number readout for a Stack.  Shows current value.  Click and type the value.  Shift-click on title to edit.'
  		globalReceiverSymbol: #NumericReadoutTile
  		nativitySelector: #authoringPrototype.
  
  	   DescriptionForPartsBin
+ 		formalName: 'Number (bare)' translatedNoop
+ 		categoryList: {'Basic' translatedNoop}
+ 		documentation: 'A number readout for a Stack.  Shows current value.  Click and type the value.' translatedNoop
- 		formalName: 'Number (bare)'
- 		categoryList: #('Basic')
- 		documentation: 'A number readout for a Stack.  Shows current value.  Click and type the value.'
  		globalReceiverSymbol: #NumericReadoutTile
  		nativitySelector: #simplePrototype.
  
  	   DescriptionForPartsBin
+ 		formalName: 'Number (mid)' translatedNoop
+ 		categoryList: {'Basic' translatedNoop}
+ 		documentation: 'A number readout for a Stack.  Shows current value.  Click and type the value.' translatedNoop
- 		formalName: 'Number (mid)'
- 		categoryList: #('Basic')
- 		documentation: 'A number readout for a Stack.  Shows current value.  Click and type the value.'
  		globalReceiverSymbol: #NumericReadoutTile
  		nativitySelector: #borderedPrototype}!

Item was added:
+ AlignmentMorphBob1 subclass: #OLPCHelpDisplayer
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !OLPCHelpDisplayer commentStamp: 'sw 2/11/2007 03:18' prior: 0!
+ A scrolling help displayer.!

Item was added:
+ ----- Method: OLPCHelpDisplayer>>setExtentFromHalo: (in category 'resizing') -----
+ setExtentFromHalo: anExtent
+ 	"The user has dragged the grow box such that the receiver's extent would be anExtent.  Do what's needed."
+ 
+ 	submorphs second extent: (anExtent x @ (anExtent y - submorphs first height))!

Item was added:
+ Object subclass: #OLPCSupport
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'XOFlashCharacter'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sugar'!

Item was added:
+ ----- Method: OLPCSupport class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"Class initialization."
+ 
+ 	"self xoFlashCharacter"!

Item was added:
+ ----- Method: OLPCSupport class>>xoCharacterWithExtent:insideColor:outsideColor: (in category 'instance creation') -----
+ xoCharacterWithExtent: anExtent insideColor: color1 outsideColor: color2
+ 	"Answer a copy of the standard XO flash character, deploying the two colors provided"
+ 
+ 	| aChar |
+ 	aChar := self xoFlashCharacter veryDeepCopy.
+ 	aChar firstColor: color1 secondColor: color2.
+ 	aChar extent: anExtent.
+ 	aChar defaultAALevel: 4.
+ 	^ aChar
+ 
+ "
+ (OLPCSupport xoCharacterWithExtent: 50 at 71 insideColor: Color red outsideColor: Color green) openInHand
+ "!

Item was added:
+ ----- Method: OLPCSupport class>>xoCharacterWithHeight:insideColor:outsideColor: (in category 'instance creation') -----
+ xoCharacterWithHeight: aHeight insideColor: color1 outsideColor: color2
+ 	"Answer a copy of the standard XO flash character, deploying the two colors provided"
+ 
+ 	| bigChar aRatio anExtent |
+ 	bigChar := self xoFlashCharacter.
+ 	aRatio := aHeight / bigChar height.
+ 	anExtent := (aRatio * bigChar width) rounded @ aHeight.
+ 	^ self xoCharacterWithExtent: anExtent insideColor: color1 outsideColor: color2
+ 
+ "
+ (OLPCSupport xoCharacterWithHeight: 25  insideColor: Color yellow outsideColor: Color green) openInHand
+ "!

Item was added:
+ ----- Method: OLPCSupport class>>xoFlashCharacter (in category 'instance creation') -----
+ xoFlashCharacter
+ 	"Answer a copy of the standard XO flash character"
+ 
+ 	XOFlashCharacter ifNil:
+ 		[XOFlashCharacter := ((FlashMorphReader on: (Base64MimeConverter mimeDecodeToBytes: 'RldTA18BAABgAC7gAC7gABUBAEMC////vwA1AQAAAQBgwKOwaqfQAgCysrIAAgICAUYAAgIC
+ IQ1uHIfTY+NWgE1eAYxzgeCzY50AKMwApnRzMdHKiATKYAc48xzjgFbMAV+PjCrasUBlSJgD
+ SUA2uJZbaSUAlmALVzB5bdsBLlATEtqVNbaAJWoBKlwEFiERLUhxoCcgCmR++OuLe43HIccA
+ pIAnkdh2TI60CSwDLLfHY7vjzjkxNsAktAyzkyyAskAsOy3uOO747HpMsQLJALTssLyG5JgS
+ KAHn73E497jjsh2KgEiYBx2FcFFYgAQIS0AF1Jvp6x306ny3LlABLQAXkmBy3kQBhKAZI0W9
+ YrLfT1jLdQgGUoBijRSokTABKyAIr29ZU/esVjKjRsAErAAivY1pUV4BQlAULt3fT6fvWNOl
+ R3AFCUBPuXsaMt25PAAAhgYGAQABAABAAAAA' readStream)) processFile submorphs first)].
+ 	^ XOFlashCharacter veryDeepCopy defaultAALevel: 4
+ 
+ "
+ (757 at 1061)  is the extent of the imported XO character.
+ ((757 @ 1061) / 15) rounded 50 at 71
+ ((OLPCSupport xoFlashCharacter extent: 50 at 71) firstColor: Color red secondColor: Color green) openInHand
+ 
+ XOFlashCharacter := nil.
+ "!

Item was added:
+ ----- Method: OLPCSupport class>>xoFlashCharacter: (in category 'instance creation') -----
+ xoFlashCharacter: aMorph
+ 	"Set the given morph to be the XO flash character."
+ 
+ 	XOFlashCharacter := aMorph
+ 
+ "
+ OLPCSupport xoFlashCharacter: (FlashMorphReader on: (Base64MimeConverter mimeDecodeToBytes: 'RldTA8wAAABgAC7gAC7gABUBAEMC////vwCiAAAAAQBgwKOwaqfQAQCysrIBRgACAgIRNW3B
+ v/vZTKlMmQCKUAizmJdBm8AlvAM+ffNptvmzKl0GLoCW8A0aJdGgBelAXTGjeyptvm02l0aA
+ F2UBeMaJTGdEAlRADJneymVvZU2lM50QCVEAMGZTJgAilAIs5nfNmUCttyDZtEvvACa9ANDR
+ m0dEAvJgC9L9CYw0UMAmRAAvL5i8wAEOYARNEvAAhgYGAQABAABAAAAA' readStream)) processFile submorphs first.
+ 
+ "!

Item was added:
+ ----- Method: Object class>>windowColorSpecification (in category '*Etoys-Squeakland-window color') -----
+ windowColorSpecification
+ 	"Answer a WindowColorSpec object that declares my preference.
+ 	This is a backstop for classes that don't otherwise define a preference."
+ 
+ 	^ WindowColorSpec classSymbol: self name
+ 		wording: 'Default' translatedNoop brightColor: #white
+ 		pastelColor: #white
+ 		helpMessage: 'Other windows without color preferences.' translatedNoop!

Item was changed:
  ----- Method: Object>>categoriesForViewer: (in category '*Etoys-viewer') -----
  categoriesForViewer: aViewer
  	"Answer a list of categories to offer in the given viewer"
  
+ 	| aList instItem |
+ 	aList _ aViewer currentVocabulary categoryListForInstance: self ofClass: self class limitClass: aViewer limitClass.
+ 	self isPlayerLike ifTrue:
+ 		[self costume isWorldMorph ifFalse:
+ 			[aList removeAllFoundIn: #(preferences display)].
+ 		^ aList].
+ 	instItem _ ScriptingSystem nameForInstanceVariablesCategory.
+ 	^ (aList includes: instItem)
+ 		ifTrue:
+ 			[aList]
+ 		ifFalse:
+ 			[ {instItem }, aList]!
- 	^ aViewer currentVocabulary categoryListForInstance: self ofClass: self class limitClass: aViewer limitClass!

Item was added:
+ ----- Method: Object>>customizeExplorerContents (in category '*Etoys-Squeakland-accessing') -----
+ customizeExplorerContents
+ 
+ 	^ false.
+ !

Item was added:
+ ----- Method: Object>>eToysEQ: (in category '*Etoys-Squeakland-comparing') -----
+ eToysEQ: anObject 
+ 
+ 	^self = anObject!

Item was added:
+ ----- Method: Object>>eToysError: (in category '*Etoys-Squeakland-error handling') -----
+ eToysError: aString 
+ 	"Throw a generic Error exception."
+ 
+ 	^EtoysError new signal: aString!

Item was added:
+ ----- Method: Object>>eToysGE: (in category '*Etoys-Squeakland-comparing') -----
+ eToysGE: anObject 
+ 
+ 	^self >= anObject!

Item was added:
+ ----- Method: Object>>eToysGT: (in category '*Etoys-Squeakland-comparing') -----
+ eToysGT: anObject 
+ 
+ 	^self > anObject!

Item was added:
+ ----- Method: Object>>eToysLE: (in category '*Etoys-Squeakland-comparing') -----
+ eToysLE: anObject 
+ 
+ 	^self <= anObject!

Item was added:
+ ----- Method: Object>>eToysLT: (in category '*Etoys-Squeakland-comparing') -----
+ eToysLT: anObject 
+ 
+ 	^self < anObject!

Item was added:
+ ----- Method: Object>>eToysNE: (in category '*Etoys-Squeakland-comparing') -----
+ eToysNE: anObject 
+ 
+ 	^self ~= anObject!

Item was added:
+ ----- Method: Object>>hasUserDefinedScripts (in category '*Etoys-Squeakland-Etoys-viewer') -----
+ hasUserDefinedScripts
+ 	"Answer whether the receiver has any user-defined scripts, in the omniuser sense of the term.  This is needed to allow Viewers to look at any object, not just at Players."
+ 
+ 	^ false!

Item was added:
+ ----- Method: Object>>inline: (in category '*Etoys-Squeakland-translation support') -----
+ inline: inlineFlag
+ 	"For translation only; noop when running in Smalltalk."!

Item was added:
+ ----- Method: Object>>is: (in category '*Etoys-Squeakland-testing') -----
+ is: aSymbol
+ 
+ 	^ false.
+ !

Item was added:
+ ----- Method: Object>>isReallyString (in category '*Etoys-Squeakland-testing') -----
+ isReallyString
+ 	^ false!

Item was added:
+ ----- Method: Object>>launchPartOffsetVia:label: (in category '*Etoys-Squeakland-user interface') -----
+ launchPartOffsetVia: aSelector label: aString
+ 	"Obtain a morph by sending aSelector to self, and attach it to the morphic hand.  This provides a general protocol for parts bins.  This variant makes the morph offset from the hand position by an amount suitable for tile-scripting in some circumstances."
+ 
+ 	| aMorph |
+ 	aMorph _ self perform: aSelector.
+ 	aMorph setNameTo: (ActiveWorld unusedMorphNameLike: aString).
+ 	aMorph setProperty: #beFullyVisibleAfterDrop toValue: true.
+ 	aMorph setProperty: #offsetForAttachingToHand toValue: 10 at -10.
+ 	aMorph fullBounds.
+ 	aMorph openInHand!

Item was added:
+ ----- Method: Object>>literalStringsDo: (in category '*Etoys-Squeakland-translating') -----
+ literalStringsDo: aBlock 
+ 	"Assuming the receiver receiver is a literal, evaluate aBlock with all Strings (but not Symbols) within it."
+ 	^ self!

Item was added:
+ ----- Method: Object>>test:ifTrue:ifFalse: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ test: cond ifTrue: trueBlock ifFalse: falseBlock
+ 
+ 	cond ifTrue: [trueBlock value: self] ifFalse: [falseBlock value: self].
+ !

Item was added:
+ ----- Method: Object>>translatedNoop (in category '*Etoys-Squeakland-translating') -----
+ translatedNoop
+ 	"This is correspondence gettext_noop() in gettext."!

Item was changed:
  ----- Method: Object>>uniqueNameForReferenceOrNil (in category '*Etoys-viewer') -----
  uniqueNameForReferenceOrNil
- 	"If the receiver has a unique name for reference, return it here, else return nil"
  
+ 	^ nil.
+ !
- 	^ References keyAtValue: self ifAbsent: [nil]!

Item was added:
+ ----- Method: Object>>var:declareC: (in category '*Etoys-Squeakland-translation support') -----
+ var: varSymbol declareC: declString
+ 	"For translation only; noop when running in Smalltalk."!

Item was added:
+ ----- Method: ObjectExplorer>>explorerFor: (in category '*Etoys-Squeakland-accessing') -----
+ explorerFor: anObject
+ 	| window listMorph |
+ 	rootObject _ anObject.
+ 	window _ (SystemWindow labelled: (rootObject printStringLimitedTo: 32)) model: self.
+ 	window addMorph: (listMorph _ SimpleHierarchicalListMorph 
+ 			on: self
+ 			list: #getList
+ 			selected: #getCurrentSelection
+ 			changeSelected: #noteNewSelection:
+ 			menu: #genericMenu:
+ 			keystroke: #explorerKey:from:)
+ 		frame: (0 at 0 corner: 1 at 0.8).
+ 	window addMorph: ((PluggableTextMorph on: self text: #trash accept: #trash:
+ 				readSelection: #contentsSelection menu: #codePaneMenu:shifted:)
+ 					askBeforeDiscardingEdits: false)
+ 		frame: (0 at 0.8 corner: 1 at 1).
+ 	listMorph autoDeselect: false.
+      ^ window!

Item was changed:
+ ----- Method: ObjectPropertiesMorph>>doEnables (in category 'enabling') -----
- ----- Method: ObjectPropertiesMorph>>doEnables (in category 'as yet unclassified') -----
  doEnables
+ 	"Carry out appropriate enablings within the receiver's interior."
+ 
+ 	| itsName fs |
+ 
+ 	fs _ myTarget fillStyle.
- 	| fs |
- 	fs := myTarget fillStyle.
  	self allMorphsDo: [ :each |
+ 		itsName _ each knownName.
- 		| itsName |
- 		itsName := each knownName.
  		itsName == #pickerForColor ifTrue: [
+ 			self enable: each when: (myTarget doesColorAndBorder and: [ fs isSolidFill | fs isGradientFill])].
- 			self enable: each when: fs isSolidFill | fs isGradientFill
- 		].
  		itsName == #pickerForBorderColor ifTrue: [
+ 			self enable: each when: (myTarget doesColorAndBorder and: [myTarget respondsTo: #borderColor:])
- 			self enable: each when: (myTarget respondsTo: #borderColor:)
  		].
  		itsName == #pickerForShadowColor ifTrue: [
  			self enable: each when: myTarget hasDropShadow
  		].
  		itsName == #pickerFor2ndGradientColor ifTrue: [
+ 			self enable: each when: (myTarget doesColorAndBorder and: [myTarget doesColorAndBorder and: [fs isGradientFill]])
- 			self enable: each when: fs isGradientFill
  		].
+ 	].
+ !
- 	].!

Item was changed:
  ----- Method: ObjectPropertiesMorph>>initialize (in category 'initialization') -----
  initialize
  "initialize the state of the receiver"
  	super initialize.
  ""
+ 	
  	myTarget
  		ifNil: [myTarget := RectangleMorph new openInWorld].
+ 	(myTarget fillStyle isSolidFill)
+ 					ifTrue:[simplePanel := true]
+ 					ifFalse:[simplePanel := false].
  	self rebuild!

Item was changed:
  ----- Method: ObjectPropertiesMorph>>makeTargetSolidFill (in category 'as yet unclassified') -----
  makeTargetSolidFill
  
+ 	myTarget color: self numberOneColor.
+ 	myTarget useSolidFill	!
- 	myTarget useSolidFill!

Item was changed:
  ----- Method: ObjectPropertiesMorph>>paneForMainColorPicker (in category 'panes') -----
  paneForMainColorPicker
  
  	^self 
  		inAColumn: {
  			self 
  				colorPickerFor: self 
  				getter: #numberOneColor 
  				setter: #numberOneColor:.
+ 			self lockedString: 'Color' translated},
+ 			(simplePanel 
+ 					ifFalse:[{(self paneForSolidFillToggle)  hResizing: #shrinkWrap}]
+ 					ifTrue:[{}]) 
- 			self lockedString: 'Color' translated.
- 			(self paneForSolidFillToggle)  hResizing: #shrinkWrap.
- 		} 
  		named: #pickerForColor.
  
  !

Item was added:
+ ----- Method: ObjectPropertiesMorph>>toggleSimplePanel (in category '*Etoys-Squeakland-as yet unclassified') -----
+ toggleSimplePanel
+ 
+ 	simplePanel := simplePanel not.
+ 	self rebuild!

Item was added:
+ ----- Method: ObjectViewer class>>on:evaluate:wheneverChangeIn: (in category '*Etoys-Squeakland-instance creation') -----
+ on: viewedObject evaluate: block1 wheneverChangeIn: block2
+ 	^ self new xxxViewedObject: viewedObject evaluate: block1 wheneverChangeIn: block2!

Item was added:
+ ----- Method: ObjectsTool>>currentCategory (in category '*Etoys-Squeakland-categories') -----
+ currentCategory
+ 	^currentCategory!

Item was added:
+ ----- Method: ObjectsTool>>currentCategory: (in category '*Etoys-Squeakland-categories') -----
+ currentCategory: aCategoryName
+ 	currentCategory _ aCategoryName.!

Item was added:
+ ----- Method: ObjectsTool>>doAlphabeticButtonAction: (in category '*Etoys-Squeakland-alphabetic') -----
+ doAlphabeticButtonAction: aCategoryName
+ 	| button |
+ 	button _ self findButtonForCategory: aCategoryName.
+ 	button ifNotNil: [
+ 		self showAlphabeticCategory: aCategoryName fromButton: button
+ 	].!

Item was added:
+ ----- Method: ObjectsTool>>doCategoryButtonAction: (in category '*Etoys-Squeakland-categories') -----
+ doCategoryButtonAction: aCategoryName
+ 	| button |
+ 	button _ self findButtonForCategory: aCategoryName.
+ 	button ifNotNil: [
+ 		self showCategory: aCategoryName fromButton: button
+ 	].!

Item was added:
+ ----- Method: ObjectsTool>>findButtonForCategory: (in category '*Etoys-Squeakland-categories') -----
+ findButtonForCategory: aCategoryName
+ 	self tabsPane submorphs
+ 		do: [ :each |
+ 			each arguments first = aCategoryName ifTrue: [^each]			
+ 		].
+ 	^nil.!

Item was added:
+ ----- Method: ObjectsTool>>helpString (in category '*Etoys-Squeakland-tabs') -----
+ helpString
+ 	"Answer the help string for the Objects Catalog."
+ 
+ 	^ 'The "Objects Catalog" allows you to browse through, and obtain copies of, many kinds of objects.
+ 
+ You will find the Objects Catalog in the Supplies flap.
+ 
+ There are three ways to use the Object Catalog, corresponding to the three tabs seen at the top:
+ 
+ alphabetic - gives you separate buttons for a, b, c, etc.  Click any button, and you will see icons of all the objects whose names begin with that letter.
+ 
+ find - gives you a type-in pane for a search.  Type any letters there, and icons of all the objects whose names match what you have typed will appear in the lower pane.
+ 
+ categories - provides buttons representing categories of related items. Click on any button to see the icons of all the objects in the category.
+ 
+ When the cursor lingers over the icon of any object, you will get balloon help for the item.
+ 
+ When you drag an icon from the Objects Catalog, it will result in a new copy of it in your hand; the new object will be deposited wherever you next click.' translated
+ 
+ "
+ ObjectsTool new presentHelp.
+ "!

Item was added:
+ ----- Method: ObjectsTool>>initializeForFlap: (in category '*Etoys-Squeakland-initialization') -----
+ initializeForFlap: forStartup
+ 	| buttonPane aBin aColor heights tabsPane |
+ 
+ 	forStartup ifTrue: [
+ 		self basicInitialize.
+ 
+ 		self layoutInset: 0;
+ 			layoutPolicy: ProportionalLayout new;
+ 			hResizing: #shrinkWrap;
+ 			vResizing: #rigid;
+ 			borderWidth: 2; borderColor: Color darkGray;
+ 			extent: (self minimumWidth @ self minimumHeight).
+ 		asStandAlone _ false.
+ 	].
+ 
+ 	"mode buttons"
+ 	buttonPane := self paneForTabs: self modeTabs.
+ 	buttonPane
+ 		vResizing: #shrinkWrap;
+ 		setNameTo: 'ButtonPane';
+ 		color: (aColor := buttonPane color) darker;
+ 		layoutInset: 6;
+ 		wrapDirection: nil;
+ 		width: self width;
+ 		layoutChanged; fullBounds.
+ 
+ 	"Place holder for a tabs or text pane"
+ 	tabsPane := Morph new
+ 		setNameTo: 'TabPane';
+ 		hResizing: #spaceFill;
+ 		yourself.
+ 
+ 	heights := { buttonPane height. 40 }.
+ 
+ 	buttonPane vResizing: #spaceFill.
+ 	self
+ 		addMorph: buttonPane
+ 		fullFrame: (LayoutFrame
+ 				fractions: (0 @ 0 corner: 1 @ 0)
+ 				offsets: (0 @ 0 corner: 0 @ heights first)).
+ 
+ 	self
+ 		addMorph: tabsPane
+ 		fullFrame: (LayoutFrame
+ 				fractions: (0 @ 0 corner: 1 @ 0)
+ 				offsets: (0 @ heights first corner: 0 @ (heights first + heights second))).
+ 
+ 	aBin := (PartsBin newPartsBinWithOrientation: #leftToRight from: #())
+ 		listDirection: #leftToRight;
+ 		wrapDirection: #topToBottom;
+ 		color: aColor lighter lighter;
+ 		setNameTo: 'Parts';
+ 		dropEnabled: false;
+ 		vResizing: #spaceFill;
+ 		yourself.
+ 
+ 	self
+ 		addMorph: aBin
+ 		fullFrame: (LayoutFrame
+ 				fractions: (0 @ 0 corner: 1 @ 1)
+ 				offsets: (0 @ (heights first + heights second) corner: 0 @ 0)).
+ 
+ 	aBin color: (Color orange muchLighter);
+ 		setNameTo: 'Objects' translated.
+ 
+ 	self color: (Color orange muchLighter);
+ 		setNameTo: 'Objects' translated.
+ !

Item was added:
+ ----- Method: ObjectsTool>>initializeToStandAlone: (in category '*Etoys-Squeakland-initialization') -----
+ initializeToStandAlone: forStartup
+ 	| buttonPane aBin aColor heights tabsPane |
+ 
+ 	forStartup ifTrue: [
+ 		self basicInitialize.
+ 
+ 		self layoutInset: 6;
+ 			layoutPolicy: ProportionalLayout new;
+ 			useRoundedCorners;
+ 			hResizing: #rigid;
+ 			vResizing: #rigid;
+ 			extent: (self minimumWidth @ self minimumHeight).
+ 
+ 		asStandAlone _ true.
+ 	].
+ 
+ 	"mode buttons"
+ 	buttonPane := self paneForTabs: self modeTabs.
+ 	buttonPane
+ 		vResizing: #shrinkWrap;
+ 		setNameTo: 'ButtonPane';
+ 		addMorphFront: self dismissButton;
+ 		addMorphBack: self helpButton;
+ 		color: (aColor := buttonPane color) darker;
+ 		layoutInset: 6;
+ 		wrapDirection: nil;
+ 		width: self width;
+ 		layoutChanged; fullBounds.
+ 
+ 	"Place holder for a tabs or text pane"
+ 	tabsPane := Morph new
+ 		setNameTo: 'TabPane';
+ 		hResizing: #spaceFill;
+ 		yourself.
+ 
+ 	heights := { buttonPane height. 40 }.
+ 
+ 	buttonPane vResizing: #spaceFill.
+ 	self
+ 		addMorph: buttonPane
+ 		fullFrame: (LayoutFrame
+ 				fractions: (0 @ 0 corner: 1 @ 0)
+ 				offsets: (0 @ 0 corner: 0 @ heights first)).
+ 
+ 	self
+ 		addMorph: tabsPane
+ 		fullFrame: (LayoutFrame
+ 				fractions: (0 @ 0 corner: 1 @ 0)
+ 				offsets: (0 @ heights first corner: 0 @ (heights first + heights second))).
+ 
+ 	aBin := (PartsBin newPartsBinWithOrientation: #leftToRight from: #())
+ 		listDirection: #leftToRight;
+ 		wrapDirection: #topToBottom;
+ 		color: aColor lighter lighter;
+ 		setNameTo: 'Parts';
+ 		dropEnabled: false;
+ 		vResizing: #spaceFill;
+ 		yourself.
+ 
+ 	self
+ 		addMorph: aBin
+ 		fullFrame: (LayoutFrame
+ 				fractions: (0 @ 0 corner: 1 @ 1)
+ 				offsets: (0 @ (heights first + heights second) corner: 0 @ 0)).
+ 
+ 	self color: (Color r: 0.0 g: 0.839 b: 0.226);
+ 		setNameTo: 'Objects' translated.
+ 
+ 	forStartup ifTrue: [
+ 		self showCategories.
+ 	]!

Item was added:
+ ----- Method: ObjectsTool>>showAlphabeticTabs: (in category '*Etoys-Squeakland-alphabetic') -----
+ showAlphabeticTabs: categoryNameToShow
+ 	"Switch to the mode of showing alphabetic tabs"
+ 
+ 	modeSymbol == #alphabetic ifTrue: [ ^self ].
+ 	self partsBin removeAllMorphs.
+ 	self initializeWithTabs: self alphabeticTabs.
+ 	self modeSymbol: #alphabetic.
+ 	categoryNameToShow isNil 
+ 			ifTrue: [self tabsPane submorphs first doButtonAction]
+ 			ifFalse: [ self doAlphabeticButtonAction: categoryNameToShow ].
+ !

Item was added:
+ ----- Method: ObjectsTool>>showCategories: (in category '*Etoys-Squeakland-categories') -----
+ showCategories: categoryNameToShow
+ 	"Set the receiver up so that it shows tabs for each of the standard categories"
+ 
+ 	modeSymbol == #categories ifTrue: [ ^self ].
+ 
+ 	self partsBin removeAllMorphs.
+ 	self initializeWithTabs: self tabsForCategories.
+ 	self modeSymbol: #categories.
+ 	categoryNameToShow isNil 
+ 		ifTrue:  [	self tabsPane submorphs first doButtonAction ]
+ 		ifFalse: [ self doCategoryButtonAction: categoryNameToShow ].
+ !

Item was added:
+ SoundCodec subclass: #OggDriver
+ 	instanceVariableNames: 'state rate channels quality headerSound'
+ 	classVariableNames: 'SpeexDefaultQuality SqOggDecode SqOggEncode SqOggError SqOggErrorHeader SqOggInitialized SqOggNeedMore SqOggRunning SqOggSuccess SqSpeex SqSpeexGotInfo SqVorbis SqVorbisGotComment SqVorbisGotInfo'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sound-Ogg'!
+ 
+ !OggDriver commentStamp: 'tak 3/9/2007 19:00' prior: 0!
+ OggDriver is a codec with Ogg container.
+ The subclass of OggDriver has responsible for actual internal codec.
+ 
+ Structure:
+  state		ByteArray -- holds internal state of the plugin.
+  rate		SmallInteger -- sample rate
+  channels	SmallInteger -- stereo = 2 or mono = 1
+  quality		Float -- codec dependent quality value.
+  headerSound OggSoundData -- It keeps the header chunk to remember meta data.
+ 
+ http://www.xiph.org/
+ !

Item was added:
+ ----- Method: OggDriver class>>example (in category 'examples') -----
+ example
+ 	"OggDriver example"
+ 	self example1. "Primitive test: Writing Ogg Vorbis."
+ 	self example2. "Primitive test: Reading Ogg Vorbis."
+ 	self example3. "Primitive metatada test: Reading Ogg Vorbis and output to Transcript."
+ 	(Delay forSeconds: 1) wait.
+ 	self example4. "Primitive test: Writing Ogg Speex."
+ 	self example5. "Primitive test: Reading Ogg Speex."
+ 	(Delay forSeconds: 1) wait.
+ 	self example6. "OggVorbisCodec test: Encode and decode with Vorbis."
+ 	(Delay forSeconds: 1) wait.
+ 	self example7. "OggSpeexCodec test: Encode and decode with Speex"
+ 	(Delay forSeconds: 1) wait.
+ 	self example8. "OggSound test: Encode and decode with Vorbis."
+ 	(Delay forSeconds: 1) wait.
+ 	self example9. "OggSound test: Encode and decode with Speex."
+ !

Item was added:
+ ----- Method: OggDriver class>>example1 (in category 'examples') -----
+ example1
+ 	"OggDriver example1"
+ 	"Primitive test: Writing Ogg Vorbis."
+ 	| driver ogg source size compressed f fileName |
+ 	fileName := 'majorChord.ogg'.
+ 	source := FMSound majorChord asSampledSound.
+ 	driver := self new.
+ 	ogg := driver
+ 				primitiveOpen: (SqVorbis bitOr: SqOggEncode).
+ 	driver primitiveSetChannels: ogg with: 1.
+ 	driver primitiveSetRate: ogg with: 22050.
+ 	driver primitiveSetQuality: ogg with: -0.1.
+ 	driver
+ 		primitiveWrite: ogg
+ 		buffer: source samples
+ 		size: source samples monoSampleCount * 2.
+ 	driver primitiveWriteEOS: ogg.
+ 	size := driver primitiveReadSize: ogg.
+ 	compressed := ByteArray new: size.
+ 	driver
+ 		primitiveRead: ogg
+ 		buffer: compressed
+ 		size: size.
+ 	driver primitiveClose: ogg.
+ 	f := FileDirectory default forceNewFileNamed: fileName.
+ 	[f binary.
+ 	f nextPutAll: compressed]
+ 		ensure: [f close]!

Item was added:
+ ----- Method: OggDriver class>>example2 (in category 'examples') -----
+ example2
+ 	"OggDriver example2"
+ 	"Primitive test: Reading Ogg Vorbis."
+ 	| f compressed driver ogg decoded size fileName rate |
+ 	fileName := 'majorChord.ogg'.
+ 	f := FileDirectory default readOnlyFileNamed: fileName.
+ 	[f binary.
+ 	compressed := f contents]
+ 		ensure: [f close].
+ 	driver := self new.
+ 	ogg := driver
+ 				primitiveOpen: (SqVorbis bitOr: SqOggDecode).
+ 	driver
+ 		primitiveWrite: ogg
+ 		buffer: compressed
+ 		size: compressed size.
+ 	rate := driver primitiveGetRate: ogg.
+ 	size := driver primitiveReadSize: ogg.
+ 	decoded := SoundBuffer newMonoSampleCount: size // 2.
+ 	driver
+ 		primitiveRead: ogg
+ 		buffer: decoded
+ 		size: size.
+ 	driver primitiveClose: ogg.
+ 	(SampledSound samples: decoded samplingRate: rate) play!

Item was added:
+ ----- Method: OggDriver class>>example3 (in category 'examples') -----
+ example3
+ 	"OggDriver example3"
+ 	"Primitive metatada test: Reading Ogg Vorbis and output to Transcript."
+ 	| f compressed driver ogg vendor comment commentSize fileName rate channels |
+ 	fileName := 'majorChord.ogg'.
+ 	f := FileDirectory default readOnlyFileNamed: fileName.
+ 	[f binary.
+ 	compressed := f contents]
+ 		ensure: [f close].
+ 	driver := self new.
+ 	ogg := driver
+ 				primitiveOpen: (SqVorbis bitOr: SqOggDecode).
+ 	driver
+ 		primitiveWrite: ogg
+ 		buffer: compressed
+ 		size: compressed size.
+ 	self assert: (driver primitiveGetState: ogg)
+ 			== SqOggRunning.
+ 	rate := driver primitiveGetRate: ogg.
+ 	channels := driver primitiveGetChannels: ogg.
+ 	Transcript cr;
+ 		show: ('Bitstream is {1} channel, {2} Hz' format: {rate. channels}).
+ 	vendor := String new: 1024.
+ 	driver
+ 		primitiveGetVendor: ogg
+ 		buffer: vendor
+ 		size: 1024.
+ 	Transcript cr; show: 'Encoded by:'
+ 			, (vendor readStream
+ 					upTo: (Character value: 0)).
+ 	commentSize := driver primitiveGetCommentSize: ogg.
+ 	comment := String new: commentSize.
+ 	driver
+ 		primitiveGetComment: ogg
+ 		buffer: comment
+ 		size: commentSize.
+ 	Transcript cr; show: comment.
+ 	driver primitiveClose: ogg!

Item was added:
+ ----- Method: OggDriver class>>example4 (in category 'examples') -----
+ example4
+ 	"OggDriver example4"
+ 	"Primitive test: Writing Ogg Speex."
+ 	| driver ogg source size compressed f fileName |
+ 	fileName := 'majorChord.spx'.
+ 	source := FMSound majorChord asSampledSound.
+ 	driver := self new.
+ 	ogg := driver
+ 				primitiveOpen: (SqSpeex bitOr: SqOggEncode).
+ 	driver primitiveSetChannels: ogg with: 1.
+ 	driver primitiveSetRate: ogg with: 22050.
+ 	driver primitiveSetQuality: ogg with: 4.0.
+ 	driver
+ 		primitiveWrite: ogg
+ 		buffer: source samples
+ 		size: source samples monoSampleCount * 2.
+ 	driver primitiveWriteEOS: ogg.
+ 	size := driver primitiveReadSize: ogg.
+ 	compressed := ByteArray new: size.
+ 	driver
+ 		primitiveRead: ogg
+ 		buffer: compressed
+ 		size: size.
+ 	driver primitiveClose: ogg.
+ 	f := FileDirectory default forceNewFileNamed: fileName.
+ 	[f binary.
+ 	f nextPutAll: compressed]
+ 		ensure: [f close]!

Item was added:
+ ----- Method: OggDriver class>>example5 (in category 'examples') -----
+ example5
+ 	"OggDriver example5"
+ 	"Primitive test: Reading Ogg Speex."
+ 	| f compressed driver ogg decoded size fileName rate |
+ 	fileName := 'majorChord.spx'.
+ 	f := FileDirectory default readOnlyFileNamed: fileName.
+ 	[f binary.
+ 	compressed := f contents]
+ 		ensure: [f close].
+ 	driver := self new.
+ 	ogg := driver
+ 				primitiveOpen: (SqSpeex bitOr: SqOggDecode).
+ 	driver
+ 		primitiveWrite: ogg
+ 		buffer: compressed
+ 		size: compressed size.
+ 	rate := driver primitiveGetRate: ogg.
+ 	size := driver primitiveReadSize: ogg.
+ 	decoded := SoundBuffer newMonoSampleCount: size // 2.
+ 	driver
+ 		primitiveRead: ogg
+ 		buffer: decoded
+ 		size: size.
+ 	driver primitiveClose: ogg.
+ 	(SampledSound samples: decoded samplingRate: rate) play!

Item was added:
+ ----- Method: OggDriver class>>example6 (in category 'examples') -----
+ example6
+ 	"OggDriver example6"
+ 	"OggVorbisCodec test: Encode and decode with Vorbis."
+ 	| src buffer codec encoded decoded |
+ 	src := SampledSound soundNamed: 'chirp'.
+ 	buffer := src samples.
+ 	codec := OggVorbisCodec new.
+ 	encoded := codec encodeSoundBuffer: buffer.
+ 	codec release.
+ 	codec := OggVorbisCodec new.
+ 	decoded := codec decodeCompressedData: encoded.
+ 	codec release.
+ 	(SampledSound samples: decoded samplingRate: src originalSamplingRate) play!

Item was added:
+ ----- Method: OggDriver class>>example7 (in category 'examples') -----
+ example7
+ 	"OggDriver example7"
+ 	"OggSpeexCodec test: Encode and decode with Speex"
+ 	| src buffer codec encoded decoded |
+ 	src := SampledSound soundNamed: 'chirp'.
+ 	buffer := src samples.
+ 	codec := OggSpeexCodec new.
+ 	encoded := codec encodeSoundBuffer: buffer.
+ 	codec release.
+ 	codec := OggSpeexCodec new.
+ 	decoded := codec decodeCompressedData: encoded.
+ 	codec release.
+ 	(SampledSound samples: decoded samplingRate: src originalSamplingRate) play!

Item was added:
+ ----- Method: OggDriver class>>example8 (in category 'examples') -----
+ example8
+ 	"OggDriver example8"
+ 	"OggSound test: Encode and decode with Vorbis."
+ 	| src compressed |
+ 	src := SampledSound soundNamed: 'croak'.
+ 	compressed := src compressWith: OggVorbisCodec.
+ 	compressed asSound play!

Item was added:
+ ----- Method: OggDriver class>>example9 (in category 'examples') -----
+ example9
+ 	"OggDriver example9"
+ 	"OggSound test: Encode and decode with Speex."
+ 	| src compressed |
+ 	src := SampledSound soundNamed: 'croak'.
+ 	compressed := src compressWith: OggSpeexCodec.
+ 	compressed asSound play!

Item was added:
+ ----- Method: OggDriver class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"self initialize"
+ 	SqOggSuccess := 0.
+ 	SqOggNeedMore := -1.
+ 	SqOggError := -2.
+ 	SqOggErrorHeader := -3.
+ 
+ 	SqOggInitialized := 1.
+ 	SqVorbisGotInfo := 2.
+ 	SqSpeexGotInfo := 2.
+ 	SqVorbisGotComment := 3.
+ 	SqOggRunning := 4.
+ 
+ 	SqOggEncode := 1.
+ 	SqOggDecode := 2.
+ 	SqVorbis := 4.
+ 	SqSpeex := 8.
+ 
+ 	self speexDefaultQuality: 4.0. !

Item was added:
+ ----- Method: OggDriver class>>isAvailable (in category 'accessing') -----
+ isAvailable
+ 	"self isAvailable"
+ 	^ self new primitiveVersion > 0!

Item was added:
+ ----- Method: OggDriver class>>playFileNamed: (in category 'class initialization') -----
+ playFileNamed: fileName 
+ 	"[self playFileNamed: 'LesVoyages.ogg'] fork"
+ 	| f compressed sound player codec |
+ 	SoundPlayer stopReverb.
+ 	player := QueueSound new.
+ 	player play.
+ 	f := FileDirectory default readOnlyFileNamed: fileName.
+ 	[f binary.
+ 	codec := self new.
+ 	[f atEnd]
+ 		whileFalse: [compressed := f next: 4096.
+ 			sound := codec soundFromCompressedData: compressed.
+ 			sound
+ 				ifNotNil: [player add: sound.
+ 					(Delay forSeconds: sound duration * 0.7) wait]]]
+ 		ensure: [f close.
+ 			codec release]!

Item was added:
+ ----- Method: OggDriver class>>services (in category 'class initialization') -----
+ services
+ 	| service |
+ 	service := SimpleServiceEntry
+ 				provider: self
+ 				label: 'sound file'
+ 				selector: #playFileNamed:
+ 				description: 'play the sound'
+ 				buttonLabel: 'play'.
+ 	^ Array with: service!

Item was added:
+ ----- Method: OggDriver class>>speexDefaultQuality: (in category 'accessing') -----
+ speexDefaultQuality: aNumber 
+ 	SpeexDefaultQuality := aNumber asFloat!

Item was added:
+ ----- Method: OggDriver>>channels (in category 'accessing') -----
+ channels
+ 	^ channels!

Item was added:
+ ----- Method: OggDriver>>channels: (in category 'accessing') -----
+ channels: aNumber
+ 	^ channels := aNumber!

Item was added:
+ ----- Method: OggDriver>>compressSound: (in category 'compress/decompress') -----
+ compressSound: aSound 
+ 	| buffer decoded |
+ 	rate := aSound originalSamplingRate asInteger.
+ 	buffer := self encodeSoundBuffer: aSound samples.
+ 	decoded := OggSoundData source: buffer codecName: self class name.
+ 	headerSound
+ 		ifNil: [headerSound := decoded]
+ 		ifNotNil: [decoded header: headerSound].
+ 	^ decoded!

Item was added:
+ ----- Method: OggDriver>>decodeCompressedData: (in category 'compress/decompress') -----
+ decodeCompressedData: aByteArray 
+ 	"Answer decompressed SoundBuffer, or nil if it needs more data"
+ 	| decoded size result |
+ 	state
+ 		ifNil: [state := self startDecoder].
+ 	result := self
+ 				primitiveWrite: state
+ 				buffer: aByteArray
+ 				size: aByteArray size.
+ 	result = SqOggSuccess
+ 		ifFalse: [self error: 'Compressed data is corrupt'].
+ 	size := self primitiveReadSize: state.
+ 	size = 0
+ 		ifTrue: [^ nil].
+ 	decoded := SoundBuffer newMonoSampleCount: size // 2.
+ 	self
+ 		primitiveRead: state
+ 		buffer: decoded
+ 		size: size.
+ 	self hasHeader
+ 		ifFalse: [self headerComplete].
+ 	^ decoded!

Item was added:
+ ----- Method: OggDriver>>encodeSoundBuffer: (in category 'compress/decompress') -----
+ encodeSoundBuffer: samples 
+ 	| size encoded |
+ 	state
+ 		ifNil: [state := self startEncoder].
+ 	self
+ 		primitiveWrite: state
+ 		buffer: samples
+ 		size: samples monoSampleCount * 2.
+ 	self primitivePacketFlush: state.
+ 	size := self primitiveReadSize: state.
+ 	encoded := ByteArray new: size.
+ 	self
+ 		primitiveRead: state
+ 		buffer: encoded
+ 		size: size.
+ 	^ encoded!

Item was added:
+ ----- Method: OggDriver>>hasHeader (in category 'accessing') -----
+ hasHeader
+ 	^ rate notNil!

Item was added:
+ ----- Method: OggDriver>>headerComplete (in category 'compress/decompress') -----
+ headerComplete
+ 	rate := self primitiveGetRate: state.
+ 	channels := self primitiveGetChannels: state!

Item was added:
+ ----- Method: OggDriver>>primitiveClose: (in category 'primitives') -----
+ primitiveClose: ogg
+ 	<primitive: 'primitiveClose' module: 'OggPlugin'>!

Item was added:
+ ----- Method: OggDriver>>primitiveExtractMono:src:size:channel: (in category 'primitives') -----
+ primitiveExtractMono: dest src: src size: size channel: channel
+ 	<primitive: 'primitiveExtractMono' module: 'OggPlugin'>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: OggDriver>>primitiveGetChannels: (in category 'primitives') -----
+ primitiveGetChannels: ogg
+ 	<primitive: 'primitiveGetChannels' module: 'OggPlugin'>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: OggDriver>>primitiveGetComment:buffer:size: (in category 'primitives') -----
+ primitiveGetComment: ogg buffer: buffer size: size
+ 	<primitive: 'primitiveGetComment' module: 'OggPlugin'>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: OggDriver>>primitiveGetCommentSize: (in category 'primitives') -----
+ primitiveGetCommentSize: ogg
+ 	<primitive: 'primitiveGetCommentSize' module: 'OggPlugin'>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: OggDriver>>primitiveGetRate: (in category 'primitives') -----
+ primitiveGetRate: ogg
+ 	<primitive: 'primitiveGetRate' module: 'OggPlugin'>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: OggDriver>>primitiveGetState: (in category 'primitives') -----
+ primitiveGetState: ogg
+ 	<primitive: 'primitiveGetState' module: 'OggPlugin'>
+ 	^ SqOggInitialized!

Item was added:
+ ----- Method: OggDriver>>primitiveGetVendor:buffer:size: (in category 'primitives') -----
+ primitiveGetVendor: ogg buffer: buffer size: size
+ 	<primitive: 'primitiveGetVendor' module: 'OggPlugin'>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: OggDriver>>primitiveOpen: (in category 'primitives') -----
+ primitiveOpen: mode
+ 	<primitive: 'primitiveOpen' module: 'OggPlugin'>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: OggDriver>>primitivePacketFlush: (in category 'primitives') -----
+ primitivePacketFlush: ogg
+ 	<primitive: 'primitivePacketFlush' module: 'OggPlugin'>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: OggDriver>>primitiveRead:buffer:size: (in category 'primitives') -----
+ primitiveRead: ogg buffer: buffer size: size
+ 	<primitive: 'primitiveRead' module: 'OggPlugin'>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: OggDriver>>primitiveReadSize: (in category 'primitives') -----
+ primitiveReadSize: ogg
+ 	<primitive: 'primitiveReadSize' module: 'OggPlugin'>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: OggDriver>>primitiveSetChannels:with: (in category 'primitives') -----
+ primitiveSetChannels: ogg with: value
+ 	<primitive: 'primitiveSetChannels' module: 'OggPlugin'>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: OggDriver>>primitiveSetQuality:with: (in category 'primitives') -----
+ primitiveSetQuality: ogg with: value
+ 	<primitive: 'primitiveSetQuality' module: 'OggPlugin'>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: OggDriver>>primitiveSetRate:with: (in category 'primitives') -----
+ primitiveSetRate: ogg with: value
+ 	<primitive: 'primitiveSetRate' module: 'OggPlugin'>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: OggDriver>>primitiveVersion (in category 'primitives') -----
+ primitiveVersion
+ 	"self new primitiveVersion"
+ 	<primitive: 'primitiveVersion' module: 'OggPlugin'>
+ 	^ 0!

Item was added:
+ ----- Method: OggDriver>>primitiveWrite:buffer:size: (in category 'primitives') -----
+ primitiveWrite: ogg buffer: buffer size: size
+ 	<primitive: 'primitiveWrite' module: 'OggPlugin'>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: OggDriver>>primitiveWriteEOS: (in category 'primitives') -----
+ primitiveWriteEOS: ogg
+ 	<primitive: 'primitiveWriteEOS' module: 'OggPlugin'>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: OggDriver>>quality (in category 'accessing') -----
+ quality
+ 	^ quality!

Item was added:
+ ----- Method: OggDriver>>quality: (in category 'accessing') -----
+ quality: aFloat
+ 	^ quality := aFloat asFloat!

Item was added:
+ ----- Method: OggDriver>>rate (in category 'accessing') -----
+ rate
+ 	^ rate!

Item was added:
+ ----- Method: OggDriver>>rate: (in category 'accessing') -----
+ rate: aNumber
+ 	^ aNumber!

Item was added:
+ ----- Method: OggDriver>>release (in category 'initialize-release') -----
+ release
+ 	state
+ 		ifNotNil: [self primitiveClose: state.
+ 			state := nil].
+ 	rate := nil.
+ 	channels := nil.
+ 	quality := nil.
+ 	headerSound := nil!

Item was added:
+ ----- Method: OggDriver>>reset (in category 'initialize-release') -----
+ reset
+ 	self release!

Item was added:
+ ----- Method: OggDriver>>samplesPerFrame (in category 'subclass responsibilities') -----
+ samplesPerFrame
+ 	^1!

Item was added:
+ ----- Method: OggDriver>>soundFromCompressedData: (in category 'accessing') -----
+ soundFromCompressedData: aByteArray 
+ 	| soundBuffer sound monoCount left right |
+ 	soundBuffer := self decodeCompressedData: aByteArray.
+ 	soundBuffer
+ 		ifNil: [^ nil].
+ 	self channels == 1
+ 		ifTrue: [^ SampledSound samples: soundBuffer samplingRate: self rate].
+ 	self channels == 2
+ 		ifTrue: [sound := MixedSound new.
+ 			monoCount := soundBuffer monoSampleCount // 2.
+ 			left := SoundBuffer newMonoSampleCount: monoCount.
+ 			self
+ 				primitiveExtractMono: left
+ 				src: soundBuffer
+ 				size: monoCount
+ 				channel: 0.
+ 			right := SoundBuffer newMonoSampleCount: monoCount.
+ 			self
+ 				primitiveExtractMono: right
+ 				src: soundBuffer
+ 				size: monoCount
+ 				channel: 1.
+ 			sound
+ 				add: (SampledSound samples: left samplingRate: self rate)
+ 				pan: 0.
+ 			sound
+ 				add: (SampledSound samples: right samplingRate: self rate)
+ 				pan: 1.
+ 			^ sound].
+ 	^ nil!

Item was added:
+ ----- Method: OggDriver>>startDecoder (in category 'initialize-release') -----
+ startDecoder
+ 	self shouldBeImplemented!

Item was added:
+ ----- Method: OggDriver>>startEncoder (in category 'initialize-release') -----
+ startEncoder
+ 	self shouldBeImplemented!

Item was added:
+ CompressedSoundData subclass: #OggSoundData
+ 	instanceVariableNames: 'decoder header'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sound-Ogg'!
+ 
+ !OggSoundData commentStamp: 'tak 3/9/2007 18:56' prior: 0!
+ Because vorbis and speex requires statefull encoding, we can't use CompressedSoundData as is. CompressedSoundData only remembers its codec class, so it doesn't help to reproduce the original context. OggSoundData remembers its header chunk to keep correspond decoder.
+ 
+ Structure:
+  decoder			SoundCodec -- decoder instance (only on header sound)
+  header			OggSound -- an OggSound including decoder
+ 
+ !

Item was added:
+ ----- Method: OggSoundData class>>codecName: (in category 'instance creation') -----
+ codecName: aSymbol
+ 	^ self new codecName: aSymbol.!

Item was added:
+ ----- Method: OggSoundData class>>example1 (in category 'examples') -----
+ example1
+ 	"OggSoundData example1"
+ 	| source codec sound |
+ 	source := FMSound majorChord asSampledSound.
+ 	sound := SequentialSound new.
+ 	codec := OggVorbisCodec new.
+ 	sound add: (codec compressSound: source).
+ 	sound add: (codec compressSound: source).
+ 	sound add: (codec compressSound: source).
+ 	sound play!

Item was added:
+ ----- Method: OggSoundData class>>source:codecName: (in category 'instance creation') -----
+ source: aByteArray codecName: aSymbol 
+ 	| instance |
+ 	instance := self new.
+ 	instance source: aByteArray.
+ 	instance codecName: aSymbol.
+ 	^ instance!

Item was added:
+ ----- Method: OggSoundData>>asSound (in category 'asSound') -----
+ asSound
+ 	| codecClass theDecoder |
+ 	self isHeader
+ 		ifTrue: [codecClass := Smalltalk
+ 						at: codecName
+ 						ifAbsent: [^ self error: 'The codec for decompressing this sound is not available'].
+ 			codecClass isAvailable
+ 				ifFalse: [^ self error: 'The codec for decompressing this sound is not available'].
+ 			decoder
+ 				ifNotNil: [decoder release].
+ 			theDecoder := decoder := codecClass new]
+ 		ifFalse: [theDecoder := header decoder].
+ 	^ theDecoder soundFromCompressedData: channels first!

Item was added:
+ ----- Method: OggSoundData>>codecName: (in category 'accessing') -----
+ codecName: aSymbol
+ 	codecName := aSymbol.!

Item was added:
+ ----- Method: OggSoundData>>codecSignature (in category 'accessing') -----
+ codecSignature
+ 	^ self className , ' codecName: ', codecName printString!

Item was added:
+ ----- Method: OggSoundData>>copy (in category 'accessing') -----
+ copy
+ 	"Don't copy!! Because OggSoundData needs correct reference for the
+ 	header, it is just a
+ 	workaround. I'll fix it later. -- takashi"
+ 	^ self!

Item was added:
+ ----- Method: OggSoundData>>decoder (in category 'accessing') -----
+ decoder
+ 	self isHeader
+ 		ifTrue: [^ decoder].
+ 	self error: 'Only header has a decoder.'!

Item was added:
+ ----- Method: OggSoundData>>header: (in category 'accessing') -----
+ header: anOggSoundData
+ 	header := anOggSoundData!

Item was added:
+ ----- Method: OggSoundData>>isHeader (in category 'accessing') -----
+ isHeader
+ 	^ header isNil!

Item was added:
+ ----- Method: OggSoundData>>printOn: (in category 'accessing') -----
+ printOn: aStream 
+ 	super printOn: aStream.
+ 	self isHeader
+ 		ifTrue: [aStream nextPutAll: '[header]']!

Item was added:
+ OggDriver subclass: #OggSpeexCodec
+ 	instanceVariableNames: 'driver'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sound-Ogg'!

Item was added:
+ ----- Method: OggSpeexCodec class>>fileReaderServicesForFile:suffix: (in category 'class initialization') -----
+ fileReaderServicesForFile: fullName suffix: suffix 
+ 	"self playFileNamed: 'majorChord.spx'"
+ 	^ suffix = 'spx'
+ 		ifTrue: [self services]
+ 		ifFalse: [#()]!

Item was added:
+ ----- Method: OggSpeexCodec class>>visibleCodecName (in category 'user interface') -----
+ visibleCodecName
+ 	"Answer a name by which this codec can be known externally."
+ 
+ 	^ 'Speex'!

Item was added:
+ ----- Method: OggSpeexCodec>>startDecoder (in category 'initialize-release') -----
+ startDecoder
+ 	^ self
+ 		primitiveOpen: (SqSpeex bitOr: SqOggDecode)!

Item was added:
+ ----- Method: OggSpeexCodec>>startEncoder (in category 'initialize-release') -----
+ startEncoder
+ 	| s |
+ 	s := self
+ 				primitiveOpen: (SqSpeex bitOr: SqOggEncode).
+ 	"now only support 1 channel"
+ 	channels := 1.
+ 	rate := rate
+ 				ifNil: [11025].
+ 	quality := quality
+ 				ifNil: [SpeexDefaultQuality].
+ 	self primitiveSetChannels: s with: channels.
+ 	self primitiveSetRate: s with: rate.
+ 	self primitiveSetQuality: s with: quality.
+ 	^ s!

Item was added:
+ OggDriver subclass: #OggVorbisCodec
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sound-Ogg'!

Item was added:
+ ----- Method: OggVorbisCodec class>>fileReaderServicesForFile:suffix: (in category 'class initialization') -----
+ fileReaderServicesForFile: fullName suffix: suffix 
+ 	"[self playFileNamed: 'LesVoyages.ogg'] fork"
+ 	^ suffix = 'ogg'
+ 		ifTrue: [self services]
+ 		ifFalse: [#()]!

Item was added:
+ ----- Method: OggVorbisCodec class>>visibleCodecName (in category 'user interface') -----
+ visibleCodecName
+ 	"Answer a name by which this codec can be known externally."
+ 
+ 	^ 'Vorbis'!

Item was added:
+ ----- Method: OggVorbisCodec>>startDecoder (in category 'initialize-release') -----
+ startDecoder
+ 	^ self
+ 		primitiveOpen: (SqVorbis bitOr: SqOggDecode)!

Item was added:
+ ----- Method: OggVorbisCodec>>startEncoder (in category 'initialize-release') -----
+ startEncoder
+ 	| s |
+ 	s := self
+ 				primitiveOpen: (SqVorbis bitOr: SqOggEncode).
+ 	channels := channels
+ 				ifNil: [1].
+ 	rate := rate
+ 				ifNil: [11025].
+ 	quality := quality
+ 				ifNil: [0.0].
+ 	self primitiveSetChannels: s with: channels.
+ 	self primitiveSetRate: s with: rate.
+ 	self primitiveSetQuality: s with: quality.
+ 	^ s!

Item was added:
+ OldSocket subclass: #OldSimpleClientSocket
+ 	instanceVariableNames: 'buffer bufferPos'
+ 	classVariableNames: 'CR CrLf LF'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-Kernel'!
+ 
+ !OldSimpleClientSocket commentStamp: '<historical>' prior: 0!
+ This class supports client for simple network protocols based on sending textual commands and responses. Examples of such protocols include POP3 (mail retrieval), SMTP (mail posting), HTTP (web browsing), and NTTP (network news). Some simple examples are presented as class methods, but a full-service client of some service should be implemented as a subclass.
+ 
+ The basic services provided by this class are:
+ 	sendCommand:			-- sends a command line terminate with <CR><LF>
+ 	getResponse				-- gets a single-line response to a command
+ 	getMultilineResponse	-- gets a multiple line response terminated by a period
+ 							-- on a line by itself
+ 
+ There are variants of the getResponse commands that display lines on the screen as they are being received. Linefeeds are stripped out of all responses.
+ 
+ The 'get' commands above make use of an internal buffer.  So intermixing these two commands and regular Socket recieve commands can cause problems.!

Item was added:
+ ----- Method: OldSimpleClientSocket class>>crLf (in category 'queries') -----
+ crLf
+ 
+ 	^ CrLf
+ !

Item was added:
+ ----- Method: OldSimpleClientSocket class>>extractDateFromAndSubjectFromHeader: (in category 'POP mail example') -----
+ extractDateFromAndSubjectFromHeader: headerString
+ 
+ 	| date from subject s lineBuf c line i |
+ 	date _ from _ subject _ ''.
+ 	s _ ReadStream on: headerString.
+ 	lineBuf _ WriteStream on: ''.
+ 	[s atEnd] whileFalse: [
+ 		c _ s next.
+ 		c = CR
+ 			ifTrue: [
+ 				line _ lineBuf contents.
+ 				(line beginsWith: 'Date: ')	ifTrue: [date _ line copyFrom: 7 to: line size].
+ 				(line beginsWith: 'From: ')	ifTrue: [from _ line copyFrom: 7 to: line size].
+ 				(line beginsWith: 'Subject: ')	ifTrue: [subject _ line copyFrom: 10 to: line size].
+ 				lineBuf _ WriteStream on: '']
+ 			ifFalse: [lineBuf nextPut: c]].
+ 
+ 	i _ date indexOf: $' ifAbsent: [0].
+ 	date _ date copyFrom: i + 1 to: date size.
+ 	^ (self simpleDateString: date), ', ', from, ':
+   ', subject
+ !

Item was added:
+ ----- Method: OldSimpleClientSocket class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"SimpleClientSocket initialize"
+ 
+ 	CR _ Character cr.
+ 	LF _ Character linefeed.
+ 
+ 	"string for command line termination:"
+ 	CrLf _ String with: CR with: LF.
+ !

Item was added:
+ ----- Method: OldSimpleClientSocket class>>parseHeaderList: (in category 'net news example') -----
+ parseHeaderList: aString
+ 	"Parse a list of newsgroup headers."
+ 
+ 	| results s lineStart |
+ 	results _ WriteStream on: (String new: aString size).
+ 	s _ ReadStream on: aString.
+ 	[s atEnd]
+ 		whileFalse: [
+ 			lineStart _ s position + 1.
+ 			3 timesRepeat: [s skipTo: Character tab].  "find fourth tab"
+ 			lineStart to: s position - 1 do: [:i | results nextPut: (aString at: i)].
+ 			results cr.
+ 			s skipTo: Character cr].
+ 	^ results contents
+ !

Item was added:
+ ----- Method: OldSimpleClientSocket class>>parseIntegerList: (in category 'net news example') -----
+ parseIntegerList: aString
+ 	"Parse a list of integers, each on a line by itself."
+ 
+ 	| s out |
+ 	s _ ReadStream on: aString.
+ 	s skipTo: Character cr.  "skip the first line"
+ 	out _ OrderedCollection new.
+ 	[s atEnd]
+ 		whileFalse: [
+ 			out addLast: (Integer readFrom: s).
+ 			s skipTo: Character cr].
+ 	^ out asArray
+ !

Item was added:
+ ----- Method: OldSimpleClientSocket class>>parseNTTPMsgList: (in category 'net news example') -----
+ parseNTTPMsgList: aString
+ 	"Parse a list of integers, each on a line by itself."
+ 
+ 	| s out |
+ 	s _ ReadStream on: aString.
+ 	s skipTo: Character cr.  "skip the first line"
+ 	out _ OrderedCollection new.
+ 	[s atEnd]
+ 		whileFalse: [
+ 			out addLast: (Integer readFrom: s).
+ 			s skipTo: Character cr].
+ 	^ out asArray
+ !

Item was added:
+ ----- Method: OldSimpleClientSocket class>>parseSensorStateString: (in category 'remote cursor example') -----
+ parseSensorStateString: aString
+ 	"Parse the given sensor stat string and return an array whose first element is the cursor point and whose second is the cursor button state."
+ 	"SimpleClientSocket parseSensorStateString: SimpleClientSocket sensorStateString"
+ 
+ 	| s buttons x y |
+ 	s _ ReadStream on: aString.
+ 	x _ Integer readFrom: s.
+ 	s skipSeparators.
+ 	y _ Integer readFrom: s.
+ 	s skipSeparators.
+ 	buttons _ Integer readFrom: s.
+ 	^ Array with: x at y with: buttons
+ !

Item was added:
+ ----- Method: OldSimpleClientSocket class>>sensorStateString (in category 'remote cursor example') -----
+ sensorStateString
+ 	"SimpleClientSocket sensorStateString"
+ 
+ 	| pt buttons s |
+ 	pt _ Sensor cursorPoint.
+ 	buttons _ Sensor primMouseButtons.
+ 	s _ WriteStream on: (String new: 100).
+ 	s nextPutAll: pt x printString.
+ 	s space.
+ 	s nextPutAll: pt y printString.
+ 	s space.
+ 	s nextPutAll: buttons printString.
+ 	^ s contents
+ !

Item was added:
+ ----- Method: OldSimpleClientSocket class>>simpleDateString: (in category 'POP mail example') -----
+ simpleDateString: dateString
+ 
+ 	| s |
+ 	s _ ReadStream on: dateString.
+ 	s skipTo: $,.  "scan thru first comma"
+ 	s atEnd ifTrue: [s reset].  "no comma found; reset s"
+ 	s skipSeparators.
+ 	^ (Date readFrom: s) mmddyyyy
+ !

Item was added:
+ ----- Method: OldSimpleClientSocket>>displayString: (in category 'as yet unclassified') -----
+ displayString: aString
+ 	"Display the given string on the Display. Used for testing."
+ 
+ 	| s |
+ 	aString isEmpty ifTrue: [^ self].
+ 	aString size > 60
+ 		ifTrue: [s _ aString copyFrom: 1 to: 60]  "limit to 60 characters"
+ 		ifFalse: [s _ aString].
+ 
+ 	s displayOn: Display.
+ !

Item was added:
+ ----- Method: OldSimpleClientSocket>>getMultilineResponse (in category 'as yet unclassified') -----
+ getMultilineResponse
+ 	"Get a multiple line response to the last command, filtering out LF characters. A multiple line response ends with a line containing only a single period (.) character."
+ 
+ 	^ self getMultilineResponseShowing: false.
+ !

Item was added:
+ ----- Method: OldSimpleClientSocket>>getMultilineResponseShowing: (in category 'as yet unclassified') -----
+ getMultilineResponseShowing: showFlag
+ 	"Get a multiple line response to the last command. A multiple line response ends with a line containing only a single period (.) character. Linefeed characters are filtered out. If showFlag is true, each line is shown in the upper-left corner of the Display as it is received."
+ 
+ 	| response done chunk |
+ 	response _ WriteStream on: ''.
+ 	done _ false.
+ 	[done] whileFalse: [
+ 		showFlag
+ 			ifTrue: [chunk _ self getResponseShowing: true]
+ 			ifFalse: [chunk _ self getResponse].
+ 		(chunk beginsWith: '.')
+ 			ifTrue: [ response nextPutAll: (chunk copyFrom: 2 to: chunk size) ]
+ 			ifFalse: [ response nextPutAll: chunk ].
+ 		done _ (chunk = ('.', String cr)) ].
+ 
+ 	^ response contents
+ !

Item was added:
+ ----- Method: OldSimpleClientSocket>>getResponse (in category 'as yet unclassified') -----
+ getResponse
+ 	"Get a one-line response from the server.  The final LF is removed from the line, but the CR is left, so that the line is in Squeak's text format"
+ 
+ 	^ self getResponseShowing: false
+ !

Item was added:
+ ----- Method: OldSimpleClientSocket>>getResponseShowing: (in category 'as yet unclassified') -----
+ getResponseShowing: showFlag
+ 
+ 	| line idx |
+ 	line _ WriteStream on: String new.
+ 
+ 	buffer ifNil: [
+ 		buffer _ String new.
+ 		bufferPos _ 0 ].
+ 
+ 	[
+ 		"look for a LF in the buffer"
+ 		idx _ buffer indexOf: Character lf startingAt: bufferPos+1 ifAbsent: [ 0 ].
+ 		idx > 0 ifTrue: [
+ 			"found it!! we have a line"
+ 			line nextPutAll: (buffer copyFrom: bufferPos+1 to: idx-1).
+ 			bufferPos _ idx.
+ 			^line contents ].
+ 		
+ 		"didn't find it.  add the whole buffer to the line, and retrieve some more data"
+ 		line nextPutAll: (buffer copyFrom: bufferPos+1 to: buffer size).
+ 		bufferPos _ 0.
+ 		buffer _ String new.
+ 		self waitForDataQueryingUserEvery: 30.
+ 		buffer _ self getData.
+ 
+ 		true
+ 	] whileTrue.!

Item was added:
+ ----- Method: OldSimpleClientSocket>>sendCommand: (in category 'as yet unclassified') -----
+ sendCommand: commandString
+ 	"Send the given command as a single line followed by a <CR><LF> terminator."
+ 
+ 	self sendData: commandString, CrLf.
+ !

Item was added:
+ ----- Method: OldSimpleClientSocket>>waitForDataQueryingUserEvery: (in category 'as yet unclassified') -----
+ waitForDataQueryingUserEvery: seconds
+ 	"Wait for data to arrive, asking the user periodically if they wish to keep waiting. If they don't wish to keep waiting, destroy the socket and raise an error."
+ 
+ 	| gotData |
+ 	gotData _ false.
+ 	[gotData]
+ 		whileFalse: [
+ 			gotData _ self waitForDataUntil: (Socket deadlineSecs: seconds).
+ 			gotData ifFalse: [
+ 				self isConnected ifFalse: [
+ 					self destroy.
+ 					self error: 'server closed connection'].
+ 				(self confirm: 'server not responding; keep trying?')
+ 					ifFalse: [
+ 						self destroy.
+ 						self error: 'no response from server']]].
+ !

Item was added:
+ Object subclass: #OldSocket
+ 	instanceVariableNames: 'semaphore socketHandle readSemaphore writeSemaphore primitiveOnlySupportsOneSemaphore'
+ 	classVariableNames: 'Connected DeadServer InvalidSocket OtherEndClosed Registry TCPSocketType ThisEndClosed UDPSocketType Unconnected WaitingForConnection'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-Kernel'!
+ 
+ !OldSocket commentStamp: '<historical>' prior: 0!
+ A Socket represents a network connection point. Current sockets are designed to support the TCP/IP and UDP protocols
+ 
+ Subclasses of socket provide support for network protocols such as POP, NNTP, HTTP, and FTP. Sockets also allow you to implement your own custom services and may be used to support Remote Procedure Call or Remote Method Invocation some day.
+ 
+ JMM June 2nd 2000 Macintosh UDP support was added if you run open transport.
+ !

Item was added:
+ ----- Method: OldSocket class>>acceptFrom: (in category 'instance creation') -----
+ acceptFrom: aSocket
+ 	^[ super new acceptFrom: aSocket ]
+ 		repeatWithGCIf: [ :sock | sock isValid not ]!

Item was added:
+ ----- Method: OldSocket class>>createIfFail: (in category 'instance creation') -----
+ createIfFail: failBlock
+ 	"Attempt to create a new socket. If successful, return the new socket. Otherwise, return the result of evaluating the given block. Socket creation can fail if the network isn't available or if there are not sufficient resources available to create another socket."
+ 	"Note: The default creates a TCP socket"
+ 	^self tcpCreateIfFail: failBlock!

Item was added:
+ ----- Method: OldSocket class>>deadServer (in category 'utilities') -----
+ deadServer
+ 
+ 	^ DeadServer!

Item was added:
+ ----- Method: OldSocket class>>deadServer: (in category 'utilities') -----
+ deadServer: aStringOrNil
+ 	"Keep the machine name of the most recently encoutered non-responding machine.  Next time the user can move it to the last in a list of servers to try."
+ 
+ 	DeadServer _ aStringOrNil!

Item was added:
+ ----- Method: OldSocket class>>deadlineSecs: (in category 'utilities') -----
+ deadlineSecs: secs
+ 	"Return a deadline time the given number of seconds from now."
+ 
+ 	^ Time millisecondClockValue + (secs * 1000)
+ !

Item was added:
+ ----- Method: OldSocket class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"Socket initialize"
+ 
+ 	"Socket Types"
+ 	TCPSocketType _ 0.
+ 	UDPSocketType _ 1.
+ 
+ 	"Socket Status Values"
+ 	InvalidSocket _ -1.
+ 	Unconnected _ 0.
+ 	WaitingForConnection _ 1.
+ 	Connected _ 2.
+ 	OtherEndClosed _ 3.
+ 	ThisEndClosed _ 4.
+ 
+ !

Item was added:
+ ----- Method: OldSocket class>>initializeNetwork (in category 'network initialization') -----
+ initializeNetwork
+ 	"Initialize the network drivers and the NetNameResolver. Do nothing if the network is already initialized."
+ 	"Note: The network must be re-initialized every time Squeak starts up, so applications that persist across snapshots should be prepared to re-initialize the network as needed. Such applications should call 'Socket initializeNetwork' before every network transaction. "
+ 
+ 	NetNameResolver initializeNetwork!

Item was added:
+ ----- Method: OldSocket class>>initializeNetworkIfFail: (in category 'network initialization') -----
+ initializeNetworkIfFail: failBlock
+ 	"Initialize the network drivers. Do nothing if the network is already initialized. Evaluate the given block if network initialization fails, perhaps because this computer isn't currently connected to a network."
+ 
+ 	NetNameResolver initializeNetwork!

Item was added:
+ ----- Method: OldSocket class>>nameForWellKnownTCPPort: (in category 'utilities') -----
+ nameForWellKnownTCPPort: portNum
+ 	"Answer the name for the given well-known TCP port number. Answer a string containing the port number if it isn't well-known."
+ 
+ 	| portList entry |
+ 	portList _ #(
+ 		(7 'echo') (9 'discard') (13 'time') (19 'characterGenerator')
+ 		(21 'ftp') (23 'telnet') (25 'smtp')
+ 		(80 'http') (110 'pop3') (119 'nntp')).
+ 	entry _ portList detect: [:pair | pair first = portNum] ifNone: [^ 'port-', portNum printString].
+ 	^ entry last
+ !

Item was added:
+ ----- Method: OldSocket class>>new (in category 'instance creation') -----
+ new
+ 	"Return a new, unconnected Socket. Note that since socket creation may fail, it is safer to use the method createIfFail: to handle such failures gracefully; this method is primarily for backward compatibility and may be disallowed in a future release."
+ 	"Note: The default creates a TCP socket - this is also backward compatibility."
+ 	^self newTCP!

Item was added:
+ ----- Method: OldSocket class>>newAcceptCheck (in category 'tests') -----
+ newAcceptCheck
+ "
+ Socket newAcceptCheck
+ "
+ 	| socket |
+ 
+ 	self initializeNetwork.
+ 	socket _ self newTCP.
+ 	socket listenOn: 44444 backlogSize: 4.
+ 	socket isValid ifTrue: [
+ 		self inform: 'Everything looks OK for the BSD style accept()'
+ 	] ifFalse: [
+ 		self inform: 'It appears that you DO NOT have support for the BSD style accept()'
+ 	].
+ 	socket destroy.
+ !

Item was added:
+ ----- Method: OldSocket class>>newTCP (in category 'instance creation') -----
+ newTCP
+ 	"Create a socket and initialise it for TCP"
+ 	^[ super new initialize: TCPSocketType ]
+ 		repeatWithGCIf: [ :socket | socket isValid not ]!

Item was added:
+ ----- Method: OldSocket class>>newUDP (in category 'instance creation') -----
+ newUDP
+ 	"Create a socket and initialise it for UDP"
+ 	^[ super new initialize: UDPSocketType ]
+ 		repeatWithGCIf: [ :socket | socket isValid not ]!

Item was added:
+ ----- Method: OldSocket class>>pingPortsOn: (in category 'utilities') -----
+ pingPortsOn: hostName 
+ 	"Attempt to connect to a set of well-known sockets on the given host, and answer the names of the available ports."
+ 
+ 	"Socket pingPortsOn: 'www.disney.com'"
+ 
+ 	^self 
+ 		pingPorts: #(7 13 19 21 23 25 80 110 119)
+ 		on: hostName
+ 		timeOutSecs: 20!

Item was added:
+ ----- Method: OldSocket class>>register: (in category 'registry') -----
+ register: anObject
+ 	WeakArray isFinalizationSupported ifFalse:[^anObject].
+ 	self registry add: anObject!

Item was added:
+ ----- Method: OldSocket class>>registry (in category 'registry') -----
+ registry
+ 	WeakArray isFinalizationSupported ifFalse:[^nil].
+ 	^Registry isNil
+ 		ifTrue:[Registry := WeakRegistry new]
+ 		ifFalse:[Registry].!

Item was added:
+ ----- Method: OldSocket class>>standardDeadline (in category 'utilities') -----
+ standardDeadline
+ 	"Return a default deadline time some seconds into the future."
+ 
+ 	^ self deadlineSecs: 45
+ !

Item was added:
+ ----- Method: OldSocket class>>tcpCreateIfFail: (in category 'instance creation') -----
+ tcpCreateIfFail: failBlock
+ 	"Attempt to create a new socket. If successful, return the new socket. Otherwise, return the result of evaluating the given block. Socket creation can fail if the network isn't available or if there are not sufficient resources available to create another socket."
+ 
+ 	| sock |
+ 	sock _ super new initialize: TCPSocketType.
+ 	sock isValid ifFalse: [^ failBlock value].
+ 	^ sock
+ !

Item was added:
+ ----- Method: OldSocket class>>udpCreateIfFail: (in category 'instance creation') -----
+ udpCreateIfFail: failBlock
+ 	"Attempt to create a new socket. If successful, return the new socket. Otherwise, return the result of evaluating the given block. Socket creation can fail if the network isn't available or if there are not sufficient resources available to create another socket."
+ 
+ 	| sock |
+ 	sock _ super new initialize: UDPSocketType.
+ 	sock isValid ifFalse: [^ failBlock value].
+ 	^ sock
+ !

Item was added:
+ ----- Method: OldSocket class>>unregister: (in category 'registry') -----
+ unregister: anObject
+ 	WeakArray isFinalizationSupported ifFalse:[^anObject].
+ 	self registry remove: anObject ifAbsent:[]!

Item was added:
+ ----- Method: OldSocket class>>wildcardAddress (in category 'utilities') -----
+ wildcardAddress
+ 	"Answer a don't-care address for use with UDP sockets."
+ 
+ 	^ByteArray new: 4		"0.0.0.0"!

Item was added:
+ ----- Method: OldSocket class>>wildcardPort (in category 'utilities') -----
+ wildcardPort
+ 	"Answer a don't-care port for use with UDP sockets.  (The system will allocate an
+ 	unused port number to the socket.)"
+ 
+ 	^0!

Item was added:
+ ----- Method: OldSocket>>accept (in category 'connection open/close') -----
+ accept
+ 	"Accept a connection from the receiver socket.
+ 	Return a new socket that is connected to the client"
+ 
+ 	^self class acceptFrom: self!

Item was added:
+ ----- Method: OldSocket>>acceptFrom: (in category 'initialize-destroy') -----
+ acceptFrom: aSocket
+ 	"Initialize a new socket handle from an accept call"
+ 	| semaIndex readSemaIndex writeSemaIndex |
+ 
+ 	primitiveOnlySupportsOneSemaphore _ false.
+ 	semaphore _ Semaphore new.
+ 	readSemaphore _ Semaphore new.
+ 	writeSemaphore _ Semaphore new.
+ 	semaIndex _ Smalltalk registerExternalObject: semaphore.
+ 	readSemaIndex _ Smalltalk registerExternalObject: readSemaphore.
+ 	writeSemaIndex _ Smalltalk registerExternalObject: writeSemaphore.
+ 	socketHandle _ self primAcceptFrom: aSocket socketHandle
+ 						receiveBufferSize: 8000
+ 						sendBufSize: 8000
+ 						semaIndex: semaIndex
+ 						readSemaIndex: readSemaIndex
+ 						writeSemaIndex: writeSemaIndex.
+ 	socketHandle = nil ifTrue: [  "socket creation failed"
+ 		Smalltalk unregisterExternalObject: semaphore.
+ 		Smalltalk unregisterExternalObject: readSemaphore.
+ 		Smalltalk unregisterExternalObject: writeSemaphore.
+ 		readSemaphore _ writeSemaphore _ semaphore _ nil
+ 	] ifFalse:[self register].
+ !

Item was added:
+ ----- Method: OldSocket>>address (in category 'accessing') -----
+ address
+ 	"Shortcut"
+ 	^self localAddress!

Item was added:
+ ----- Method: OldSocket>>bindTo: (in category 'ipv6') -----
+ bindTo: aSocketAddress
+ 
+ 	| status |
+ 	self initializeNetwork.
+ 	status _ self primSocketConnectionStatus: socketHandle.
+ 	(status == Unconnected)
+ 		ifFalse: [InvalidSocketStatusException signal: 'Socket status must Unconnected when binding it to an address'].
+ 
+ 	self primSocket: socketHandle bindTo: aSocketAddress.
+ !

Item was added:
+ ----- Method: OldSocket>>close (in category 'connection open/close') -----
+ close
+ 	"Close this connection gracefully. For TCP, this sends a close request, but the stream remains open until the other side also closes it."
+ 
+ 	self primSocketCloseConnection: socketHandle.  "close this end"
+ !

Item was added:
+ ----- Method: OldSocket>>closeAndDestroy (in category 'connection open/close') -----
+ closeAndDestroy
+ 	"First, try to close this connection gracefully. If the close attempt fails or times out, abort the connection. In either case, destroy the socket. Do nothing if the socket has already been destroyed (i.e., if its socketHandle is nil)."
+ 
+ 	self closeAndDestroy: 20.
+ 
+ !

Item was added:
+ ----- Method: OldSocket>>closeAndDestroy: (in category 'connection open/close') -----
+ closeAndDestroy: timeoutSeconds 
+ 	"First, try to close this connection gracefully. If the close attempt fails or times out, abort the connection. In either case, destroy the socket. Do nothing if the socket has already been destroyed (i.e., if its socketHandle is nil)."
+ 
+ 	socketHandle = nil 
+ 		ifFalse: 
+ 			[self isConnected 
+ 				ifTrue: 
+ 					[self close.	"close this end"
+ 					(self waitForDisconnectionUntil: (self class deadlineSecs: timeoutSeconds)) 
+ 						ifFalse: 
+ 							["if the other end doesn't close soon, just abort the connection"
+ 
+ 							self primSocketAbortConnection: socketHandle]].
+ 			self destroy]!

Item was added:
+ ----- Method: OldSocket>>connectNonBlockingTo: (in category 'ipv6') -----
+ connectNonBlockingTo: aSocketAddress
+ 
+ 	| status |
+ 	self initializeNetwork.
+ 	status _ self primSocketConnectionStatus: socketHandle.
+ 	(status == Unconnected)
+ 		ifFalse: [InvalidSocketStatusException signal: 'Socket status must Unconnected before opening a new connection'].
+ 
+ 	self primSocket: socketHandle connectTo: aSocketAddress.
+ !

Item was added:
+ ----- Method: OldSocket>>connectTo: (in category 'ipv6') -----
+ connectTo: aSocketAddress
+ 
+ 	self connectTo: aSocketAddress waitForConnectionFor: Socket standardTimeout!

Item was added:
+ ----- Method: OldSocket>>connectTo:port: (in category 'connection open/close') -----
+ connectTo: hostAddress port: port
+ 	"Initiate a connection to the given port at the given host address. This operation will return immediately; follow it with waitForConnectionUntil: to wait until the connection is established."
+ 
+ 	NetNameResolver useOldNetwork
+ 		ifTrue: [	| status |
+ 	status _ self primSocketConnectionStatus: socketHandle.
+ 	(status == Unconnected)
+ 		ifFalse: [self error: 'Socket status must Unconnected before opening a new connection'].
+ 
+ 	self primSocket: socketHandle connectTo: hostAddress port: port.
+ ]
+ 		ifFalse: [
+ 			hostAddress port: port.
+ 			self connectTo: hostAddress]!

Item was added:
+ ----- Method: OldSocket>>connectTo:waitForConnectionFor: (in category 'ipv6') -----
+ connectTo: aSocketAddress waitForConnectionFor: timeout 
+ 
+ 	self connectNonBlockingTo: aSocketAddress.
+ 	self
+ 		waitForConnectionFor: timeout
+ 		ifTimedOut: [ConnectionTimedOut signal: 'Cannot connect to ', aSocketAddress printString]!

Item was added:
+ ----- Method: OldSocket>>dataAvailable (in category 'queries') -----
+ dataAvailable
+ 	"Return true if this socket has unread received data."
+ 
+ 	socketHandle == nil ifTrue: [^ false].
+ 	^ self primSocketReceiveDataAvailable: socketHandle
+ !

Item was added:
+ ----- Method: OldSocket>>destroy (in category 'initialize-destroy') -----
+ destroy
+ 	"Destroy this socket. Its connection, if any, is aborted and its resources are freed. Do nothing if the socket has already been destroyed (i.e., if its socketHandle is nil)."
+ 
+ 	socketHandle = nil ifFalse: 
+ 		[self isValid ifTrue: [self primSocketDestroy: socketHandle].
+ 		Smalltalk unregisterExternalObject: semaphore.
+ 		Smalltalk unregisterExternalObject: readSemaphore.
+ 		Smalltalk unregisterExternalObject: writeSemaphore.
+ 		socketHandle _ nil.
+ 		readSemaphore _ writeSemaphore _ semaphore _ nil.
+ 		self unregister].
+ !

Item was added:
+ ----- Method: OldSocket>>discardReceivedData (in category 'sending-receiving') -----
+ discardReceivedData
+ 	"Discard any data received up until now, and return the number of bytes discarded."
+ 
+ 	| buf totalBytesDiscarded |
+ 	buf _ String new: 10000.
+ 	totalBytesDiscarded _ 0.
+ 	[self isConnected and: [self dataAvailable]] whileTrue: [
+ 		totalBytesDiscarded _
+ 			totalBytesDiscarded + (self receiveDataInto: buf)].
+ 	^ totalBytesDiscarded
+ !

Item was added:
+ ----- Method: OldSocket>>disconnect (in category 'connection open/close') -----
+ disconnect
+ 	"Break this connection, no matter what state it is in. Data that has been sent but not received will be lost."
+ 
+ 	self primSocketAbortConnection: socketHandle.
+ !

Item was added:
+ ----- Method: OldSocket>>finalize (in category 'finalization') -----
+ finalize
+ 	self primSocketDestroyGently: socketHandle.
+ 	Smalltalk unregisterExternalObject: semaphore.
+ 	Smalltalk unregisterExternalObject: readSemaphore.
+ 	Smalltalk unregisterExternalObject: writeSemaphore.
+ !

Item was added:
+ ----- Method: OldSocket>>getData (in category 'sending-receiving') -----
+ getData
+ 	"Get some data"
+ 
+ 	| buf bytesRead |
+ 	(self waitForDataUntil: self class standardDeadline) 
+ 		ifFalse: [self error: 'getData timeout'].
+ 	buf := String new: 4000.
+ 	bytesRead := self 
+ 				primSocket: socketHandle
+ 				receiveDataInto: buf
+ 				startingAt: 1
+ 				count: buf size.
+ 	^buf copyFrom: 1 to: bytesRead!

Item was added:
+ ----- Method: OldSocket>>getOption: (in category 'other') -----
+ getOption: aName 
+ 	"Get options on this socket, see Unix man pages for values for 
+ 	sockets, IP, TCP, UDP. IE SO_KEEPALIVE
+ 	returns an array, element one is an status number (0 ok, -1 read only option)
+ 	element two is the resulting of the requested option"
+ 
+ 	(socketHandle == nil or: [self isValid not])
+ 		ifTrue: [self error: 'Socket status must valid before getting an option'].
+ 	^self primSocket: socketHandle getOption: aName
+ 
+ "| foo options |
+ Socket initializeNetwork.
+ foo _ Socket newTCP.
+ foo connectTo: (NetNameResolver addressFromString: '192.168.1.1') port: 80.
+ foo waitForConnectionUntil: (Socket standardDeadline).
+ 
+ options _ {
+ 'SO_DEBUG'. 'SO_REUSEADDR'. 'SO_REUSEPORT'. 'SO_DONTROUTE'.
+ 'SO_BROADCAST'. 'SO_SNDBUF'. 'SO_RCVBUF'. 'SO_KEEPALIVE'.
+ 'SO_OOBINLINE'. 'SO_PRIORITY'. 'SO_LINGER'. 'SO_RCVLOWAT'.
+ 'SO_SNDLOWAT'. 'IP_TTL'. 'IP_HDRINCL'. 'IP_RCVOPTS'.
+ 'IP_RCVDSTADDR'. 'IP_MULTICAST_IF'. 'IP_MULTICAST_TTL'.
+ 'IP_MULTICAST_LOOP'. 'UDP_CHECKSUM'. 'TCP_MAXSEG'.
+ 'TCP_NODELAY'. 'TCP_ABORT_THRESHOLD'. 'TCP_CONN_NOTIFY_THRESHOLD'. 
+ 'TCP_CONN_ABORT_THRESHOLD'. 'TCP_NOTIFY_THRESHOLD'.
+ 'TCP_URGENT_PTR_TYPE'}.
+ 
+ 1 to: options size do: [:i | | fum |
+ 	fum _foo getOption: (options at: i).
+ 	Transcript show: (options at: i),fum printString;cr].
+ 
+ foo _ Socket newUDP.
+ foo setPeer: (NetNameResolver addressFromString: '192.168.1.9') port: 7.
+ foo waitForConnectionUntil: (Socket standardDeadline).
+ 
+ 1 to: options size do: [:i | | fum |
+ 	fum _foo getOption: (options at: i).
+ 	Transcript show: (options at: i),fum printString;cr].
+ "!

Item was added:
+ ----- Method: OldSocket>>getResponseNoLF (in category 'other') -----
+ getResponseNoLF
+ 	"Get the response to the last command."
+ 
+ 	| buf response bytesRead c lf |
+ 	(self waitForDataUntil: (self class deadlineSecs: 20)) 
+ 		ifFalse: [self error: 'getResponse timeout'].
+ 	lf := Character lf.
+ 	buf := String new: 1000.
+ 	response := WriteStream on: ''.
+ 	[self dataAvailable] whileTrue: 
+ 			[bytesRead := self 
+ 						primSocket: socketHandle
+ 						receiveDataInto: buf
+ 						startingAt: 1
+ 						count: buf size.
+ 			1 to: bytesRead
+ 				do: [:i | (c := buf at: i) ~= lf ifTrue: [response nextPut: c]]].
+ 	^response contents!

Item was added:
+ ----- Method: OldSocket>>initialize: (in category 'initialize-destroy') -----
+ initialize: socketType
+ 	"Initialize a new socket handle. If socket creation fails, socketHandle will be set to nil."
+ 	| semaIndex readSemaIndex writeSemaIndex |
+ 
+ 	primitiveOnlySupportsOneSemaphore _ false.
+ 	semaphore _ Semaphore new.
+ 	readSemaphore _ Semaphore new.
+ 	writeSemaphore _ Semaphore new.
+ 	semaIndex _ Smalltalk registerExternalObject: semaphore.
+ 	readSemaIndex _ Smalltalk registerExternalObject: readSemaphore.
+ 	writeSemaIndex _ Smalltalk registerExternalObject: writeSemaphore.
+ 	socketHandle _
+ 		self primSocketCreateNetwork: 0
+ 			type: socketType
+ 			receiveBufferSize: 8000
+ 			sendBufSize: 8000
+ 			semaIndex: semaIndex
+ 			readSemaIndex: readSemaIndex
+ 			writeSemaIndex: writeSemaIndex.
+ 
+ 	socketHandle = nil ifTrue: [  "socket creation failed"
+ 		Smalltalk unregisterExternalObject: semaphore.
+ 		Smalltalk unregisterExternalObject: readSemaphore.
+ 		Smalltalk unregisterExternalObject: writeSemaphore.
+ 		readSemaphore _ writeSemaphore _ semaphore _ nil
+ 	] ifFalse:[self register].
+ !

Item was added:
+ ----- Method: OldSocket>>initializeNetwork (in category 'other') -----
+ initializeNetwork
+ 	self class initializeNetwork!

Item was added:
+ ----- Method: OldSocket>>isConnected (in category 'queries') -----
+ isConnected
+ 	"Return true if this socket is connected."
+ 
+ 	socketHandle == nil ifTrue: [^ false].
+ 	^ (self primSocketConnectionStatus: socketHandle) == Connected
+ !

Item was added:
+ ----- Method: OldSocket>>isOtherEndClosed (in category 'queries') -----
+ isOtherEndClosed
+ 	"Return true if this socket had the other end closed."
+ 
+ 	socketHandle == nil ifTrue: [^ false].
+ 	^ (self primSocketConnectionStatus: socketHandle) == OtherEndClosed
+ !

Item was added:
+ ----- Method: OldSocket>>isThisEndClosed (in category 'queries') -----
+ isThisEndClosed
+ 	"Return true if this socket had the this end closed."
+ 
+ 	socketHandle == nil ifTrue: [^ false].
+ 	^ (self primSocketConnectionStatus: socketHandle) == ThisEndClosed
+ !

Item was added:
+ ----- Method: OldSocket>>isUnconnected (in category 'queries') -----
+ isUnconnected
+ 	"Return true if this socket's state is Unconnected."
+ 
+ 	socketHandle == nil ifTrue: [^ false].
+ 	^ (self primSocketConnectionStatus: socketHandle) == Unconnected
+ !

Item was added:
+ ----- Method: OldSocket>>isUnconnectedOrInvalid (in category 'queries') -----
+ isUnconnectedOrInvalid
+ 	"Return true if this socket is completely disconnected or is invalid."
+ 
+ 	| status |
+ 	socketHandle == nil ifTrue: [^ true].
+ 	status _ self primSocketConnectionStatus: socketHandle.
+ 	^ (status = Unconnected) | (status = InvalidSocket)
+ !

Item was added:
+ ----- Method: OldSocket>>isValid (in category 'queries') -----
+ isValid
+ 	"Return true if this socket contains a valid, non-nil socket handle."
+ 
+ 	| status |
+ 	socketHandle == nil ifTrue: [^ false].
+ 	status _ self primSocketConnectionStatus: socketHandle.
+ 	^ status ~= InvalidSocket
+ !

Item was added:
+ ----- Method: OldSocket>>isWaitingForConnection (in category 'queries') -----
+ isWaitingForConnection
+ 	"Return true if this socket is waiting for a connection."
+ 
+ 	socketHandle == nil ifTrue: [^ false].
+ 	^ (self primSocketConnectionStatus: socketHandle) == WaitingForConnection
+ !

Item was added:
+ ----- Method: OldSocket>>listenOn: (in category 'connection open/close') -----
+ listenOn: port
+ 	"Listen for a connection on the given port. This operation will return immediately; follow it with waitForConnectionUntil: to wait until a connection is established."
+ 
+ 	| status |
+ 	status _ self primSocketConnectionStatus: socketHandle.
+ 	(status == Unconnected)
+ 		ifFalse: [self error: 'Socket status must Unconnected before listening for a new connection'].
+ 
+ 	self primSocket: socketHandle listenOn: port.
+ !

Item was added:
+ ----- Method: OldSocket>>listenOn:backlogSize: (in category 'connection open/close') -----
+ listenOn: portNumber backlogSize: backlog
+ 	"Listen for a connection on the given port.
+ 	If this method succeeds, #accept may be used to establish a new connection"
+ 	| status |
+ 	status _ self primSocketConnectionStatus: socketHandle.
+ 	(status == Unconnected)
+ 		ifFalse: [self error: 'Socket status must Unconnected before listening for a new connection'].
+ 	self primSocket: socketHandle listenOn: portNumber backlogSize: backlog.
+ !

Item was added:
+ ----- Method: OldSocket>>listenOn:backlogSize:interface: (in category 'connection open/close') -----
+ listenOn: portNumber backlogSize: backlog interface: ifAddr
+ 	"Listen for a connection on the given port.
+ 	If this method succeeds, #accept may be used to establish a new connection"
+ 	| status |
+ 	status _ self primSocketConnectionStatus: socketHandle.
+ 	(status == Unconnected)
+ 		ifFalse: [self error: 'Socket status must Unconnected before listening for a new connection'].
+ 	self primSocket: socketHandle listenOn: portNumber backlogSize: backlog interface: ifAddr.
+ !

Item was added:
+ ----- Method: OldSocket>>listenWithBacklog: (in category 'ipv6') -----
+ listenWithBacklog: backlogSize
+ 
+ 	| status |
+ 	self initializeNetwork.
+ 	status _ self primSocketConnectionStatus: socketHandle.
+ 	(status == Unconnected)
+ 		ifFalse: [InvalidSocketStatusException signal: 'Socket status must Unconnected before it can listen for connections'].
+ 
+ 	self primSocket: socketHandle listenWithBacklog: backlogSize.
+ !

Item was added:
+ ----- Method: OldSocket>>localAddress (in category 'accessing') -----
+ localAddress
+ 	self waitForConnectionUntil: self class standardDeadline.
+ 	self isConnected ifFalse: [^ByteArray new: 4].
+ 	^self primSocketLocalAddress: socketHandle!

Item was added:
+ ----- Method: OldSocket>>localPort (in category 'accessing') -----
+ localPort
+ 	self waitForConnectionUntil: self class standardDeadline.
+ 	self isConnected ifFalse: [^0].
+ 	^self primSocketLocalPort: socketHandle!

Item was added:
+ ----- Method: OldSocket>>localSocketAddress (in category 'ipv6') -----
+ localSocketAddress
+ 
+ 	| size addr |
+ 	size := self primSocketLocalAddressSize: socketHandle.
+ 	addr := SocketAddress new: size.
+ 	self primSocket: socketHandle localAddressResult: addr.
+ 	^addr!

Item was added:
+ ----- Method: OldSocket>>peerName (in category 'accessing') -----
+ peerName
+ 	"Return the name of the host I'm connected to, or nil if its name isn't known to the domain name server or the request times out."
+ 	"Note: Slow. Calls the domain name server, taking up to 20 seconds to time out. Even when sucessful, delays of up to 13 seconds have been observed during periods of high network load." 
+ 
+ 	^self remoteSocketAddress hostName!

Item was added:
+ ----- Method: OldSocket>>port (in category 'accessing') -----
+ port
+ 	"Shortcut"
+ 	^self localPort!

Item was added:
+ ----- Method: OldSocket>>primAcceptFrom:receiveBufferSize:sendBufSize:semaIndex: (in category 'primitives') -----
+ primAcceptFrom: aHandle receiveBufferSize: rcvBufSize sendBufSize: sndBufSize semaIndex: semaIndex
+ 	"Create and return a new socket handle based on accepting the connection from the given listening socket"
+ 	<primitive: 'primitiveSocketAccept' module: 'SocketPlugin'>
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: OldSocket>>primAcceptFrom:receiveBufferSize:sendBufSize:semaIndex:readSemaIndex:writeSemaIndex: (in category 'primitives') -----
+ primAcceptFrom: aHandle receiveBufferSize: rcvBufSize sendBufSize: sndBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema
+ 	"Create and return a new socket handle based on accepting the connection from the given listening socket"
+ 	<primitive: 'primitiveSocketAccept3Semaphores' module: 'SocketPlugin'>
+ 	primitiveOnlySupportsOneSemaphore _ true.
+ 	^self primAcceptFrom: aHandle receiveBufferSize: rcvBufSize sendBufSize: sndBufSize semaIndex: semaIndex !

Item was added:
+ ----- Method: OldSocket>>primSocket:bindTo: (in category 'primitives-ipv6') -----
+ primSocket: socketID bindTo: socketAddress
+ 
+ 	<primitive: 'primitiveSocketBindTo' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocket:connectTo: (in category 'primitives-ipv6') -----
+ primSocket: socketID connectTo: socketAddress
+ 
+ 	<primitive: 'primitiveSocketConnectTo' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocket:connectTo:port: (in category 'primitives') -----
+ primSocket: socketID connectTo: hostAddress port: port
+ 	"Attempt to establish a connection to the given port of the given host. This is an asynchronous call; query the socket status to discover if and when the connection is actually completed."
+ 
+ 	<primitive: 'primitiveSocketConnectToPort' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocket:getOption: (in category 'primitives') -----
+ primSocket: socketID getOption: aString 
+ 	"Get some option information on this socket. Refer to the UNIX 
+ 	man pages for valid SO, TCP, IP, UDP options. In case of doubt
+ 	refer to the source code.
+ 	TCP_NODELAY, SO_KEEPALIVE are valid options for example
+ 	returns an array containing the error code and the option value"
+ 
+ 	<primitive: 'primitiveSocketGetOptions' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocket:listenOn: (in category 'primitives') -----
+ primSocket: socketID listenOn: port
+ 	"Listen for a connection on the given port. This is an asynchronous call; query the socket status to discover if and when the connection is actually completed."
+ 
+ 	<primitive: 'primitiveSocketListenWithOrWithoutBacklog' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocket:listenOn:backlogSize: (in category 'primitives') -----
+ primSocket: aHandle listenOn: portNumber backlogSize: backlog
+ 	"Primitive. Set up the socket to listen on the given port.
+ 	Will be used in conjunction with #accept only."
+ 	<primitive: 'primitiveSocketListenWithOrWithoutBacklog' module: 'SocketPlugin'>
+ 	self destroy. "Accept not supported so clean up"!

Item was added:
+ ----- Method: OldSocket>>primSocket:listenOn:backlogSize:interface: (in category 'primitives') -----
+ primSocket: aHandle listenOn: portNumber backlogSize: backlog interface: ifAddr
+ 	"Primitive. Set up the socket to listen on the given port.
+ 	Will be used in conjunction with #accept only."
+ 	<primitive: 'primitiveSocketListenOnPortBacklogInterface' module: 'SocketPlugin'>
+ 	self destroy. "Accept not supported so clean up"!

Item was added:
+ ----- Method: OldSocket>>primSocket:listenWithBacklog: (in category 'primitives-ipv6') -----
+ primSocket: socketID listenWithBacklog: backlogSize
+ 
+ 	<primitive: 'primitiveSocketListenWithBacklog' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocket:localAddressResult: (in category 'primitives-ipv6') -----
+ primSocket: socketID localAddressResult: socketAddress
+ 
+ 	<primitive: 'primitiveSocketLocalAddressResult' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocket:receiveDataInto:startingAt:count: (in category 'primitives') -----
+ primSocket: socketID receiveDataInto: aStringOrByteArray startingAt: startIndex count: count
+ 	"Receive data from the given socket into the given array starting at the given index. Return the number of bytes read or zero if no data is available."
+ 
+ 	<primitive: 'primitiveSocketReceiveDataBufCount' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocket:receiveUDPDataInto:startingAt:count: (in category 'primitives') -----
+ primSocket: socketID receiveUDPDataInto: aStringOrByteArray startingAt: startIndex count: count
+ 	"Receive data from the given socket into the given array starting at the given index. 
+ 	Return an Array containing the amount read, the host address byte array, the host port, and the more flag"
+ 
+ 	<primitive: 'primitiveSocketReceiveUDPDataBufCount' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocket:remoteAddressResult: (in category 'primitives-ipv6') -----
+ primSocket: socketID remoteAddressResult: socketAddress
+ 
+ 	<primitive: 'primitiveSocketRemoteAddressResult' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocket:sendData:startIndex:count: (in category 'primitives') -----
+ primSocket: socketID sendData: aStringOrByteArray startIndex: startIndex count: count
+ 	"Send data to the remote host through the given socket starting with the given byte index of the given byte array. The data sent is 'pushed' immediately. Return the number of bytes of data actually sent; any remaining data should be re-submitted for sending after the current send operation has completed."
+ 	"Note: In general, it many take several sendData calls to transmit a large data array since the data is sent in send-buffer-sized chunks. The size of the send buffer is determined when the socket is created."
+ 
+ 	<primitive: 'primitiveSocketSendDataBufCount' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocket:sendUDPData:toHost:port:startIndex:count: (in category 'primitives') -----
+ primSocket: socketID sendUDPData: aStringOrByteArray toHost: hostAddress  port: portNumber startIndex: startIndex count: count
+ 	"Send data to the remote host through the given socket starting with the given byte index of the given byte array. The data sent is 'pushed' immediately. Return the number of bytes of data actually sent; any remaining data should be re-submitted for sending after the current send operation has completed."
+ 	"Note: In general, it many take several sendData calls to transmit a large data array since the data is sent in send-buffer-sized chunks. The size of the send buffer is determined when the socket is created."
+ 
+ 	<primitive:  'primitiveSocketSendUDPDataBufCount' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ 
+ !

Item was added:
+ ----- Method: OldSocket>>primSocket:setOption:value: (in category 'primitives') -----
+ primSocket: socketID setOption: aString value: aStringValue
+ 	"Set some option information on this socket. Refer to the UNIX 
+ 	man pages for valid SO, TCP, IP, UDP options. In case of doubt
+ 	refer to the source code.
+ 	TCP_NODELAY, SO_KEEPALIVE are valid options for example
+ 	returns an array containing the error code and the negotiated value"
+ 
+ 	<primitive: 'primitiveSocketSetOptions' module: 'SocketPlugin'>
+ 	^nil!

Item was added:
+ ----- Method: OldSocket>>primSocket:setPort: (in category 'primitives') -----
+ primSocket: socketID setPort: port
+ 	"Set the local port associated with a UDP socket.
+ 	Note: this primitive is overloaded.  The primitive will not fail on a TCP socket, but
+ 	the effects will not be what was desired.  Best solution would be to split Socket into
+ 	two subclasses, TCPSocket and UDPSocket."
+ 
+ 	<primitive: 'primitiveSocketListenWithOrWithoutBacklog' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocketAbortConnection: (in category 'primitives') -----
+ primSocketAbortConnection: socketID
+ 	"Terminate the connection on the given port immediately without going through the normal close sequence. This is an asynchronous call; query the socket status to discover if and when the connection is actually terminated."
+ 
+ 	<primitive: 'primitiveSocketAbortConnection' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocketCloseConnection: (in category 'primitives') -----
+ primSocketCloseConnection: socketID
+ 	"Close the connection on the given port. The remote end is informed that this end has closed and will do no further sends. This is an asynchronous call; query the socket status to discover if and when the connection is actually closed."
+ 
+ 	<primitive: 'primitiveSocketCloseConnection' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocketConnectionStatus: (in category 'primitives') -----
+ primSocketConnectionStatus: socketID
+ 	"Return an integer reflecting the connection status of this socket. For a list of possible values, see the comment in the 'initialize' method of this class. If the primitive fails, return a status indicating that the socket handle is no longer valid, perhaps because the Squeak image was saved and restored since the socket was created. (Sockets do not survive snapshots.)"
+ 
+ 	<primitive: 'primitiveSocketConnectionStatus' module: 'SocketPlugin'>
+ 	^ InvalidSocket
+ !

Item was added:
+ ----- Method: OldSocket>>primSocketCreateNetwork:type:receiveBufferSize:sendBufSize:semaIndex: (in category 'primitives') -----
+ primSocketCreateNetwork: netType type: socketType receiveBufferSize: rcvBufSize sendBufSize: sendBufSize semaIndex: semaIndex
+ 	"Return a new socket handle for a socket of the given type and buffer sizes. Return nil if socket creation fails.
+ 	The netType parameter is platform dependent and can be used to encode both the protocol type (IP, Xerox XNS, etc.) and/or the physical network interface to use if this host is connected to multiple networks. A zero netType means to use IP protocols and the primary (or only) network interface.
+ 	The socketType parameter specifies:
+ 		0	reliable stream socket (TCP if the protocol is IP)
+ 		1	unreliable datagram socket (UDP if the protocol is IP)
+ 	The buffer size parameters allow performance to be tuned to the application. For example, a larger receive buffer should be used when the application expects to be receiving large amounts of data, especially from a host that is far away. These values are considered requests only; the underlying implementation will ensure that the buffer sizes actually used are within allowable bounds. Note that memory may be limited, so an application that keeps many sockets open should use smaller buffer sizes. Note the macintosh implementation ignores this buffer size. Also see setOption to get/set socket buffer sizes which allows you to set/get the current buffer sizes for reading and writing.
+  	If semaIndex is > 0, it is taken to be the index of a Semaphore in the external objects array to be associated with this socket. This semaphore will be signalled when the socket status changes, such as when data arrives or a send completes. All processes waiting on the semaphore will be awoken for each such event; each process must then query the socket state to figure out if the conditions they are waiting for have been met. For example, a process waiting to send some data can see if the last send has completed."
+ 
+ 	<primitive: 'primitiveSocketCreate' module: 'SocketPlugin'>
+ 	^ nil  "socket creation failed"
+ !

Item was added:
+ ----- Method: OldSocket>>primSocketCreateNetwork:type:receiveBufferSize:sendBufSize:semaIndex:readSemaIndex:writeSemaIndex: (in category 'primitives') -----
+ primSocketCreateNetwork: netType type: socketType receiveBufferSize: rcvBufSize sendBufSize: sendBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema
+ 	"See comment in primSocketCreateNetwork: with one semaIndex. However you should know that some implementations
+ 	ignore the buffer size and this interface supports three semaphores,  one for open/close/listen and the other two for
+ 	reading and writing"
+ 
+ 	<primitive: 'primitiveSocketCreate3Semaphores' module: 'SocketPlugin'>
+ 	primitiveOnlySupportsOneSemaphore _ true.
+ 	^ self primSocketCreateNetwork: netType
+ 			type: socketType
+ 			receiveBufferSize: rcvBufSize
+ 			sendBufSize: sendBufSize
+ 			semaIndex: semaIndex!

Item was added:
+ ----- Method: OldSocket>>primSocketDestroy: (in category 'primitives') -----
+ primSocketDestroy: socketID
+ 	"Release the resources associated with this socket. If a connection is open, it is aborted."
+ 
+ 	<primitive: 'primitiveSocketDestroy' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocketDestroyGently: (in category 'primitives') -----
+ primSocketDestroyGently: socketID
+ 	"Release the resources associated with this socket. If a connection is open, it is aborted.
+ 	Do not fail if the receiver is already closed."
+ 
+ 	<primitive: 'primitiveSocketDestroy' module: 'SocketPlugin'>
+ !

Item was added:
+ ----- Method: OldSocket>>primSocketError: (in category 'primitives') -----
+ primSocketError: socketID
+ 	"Return an integer encoding the most recent error on this socket. Zero means no error."
+ 
+ 	<primitive: 'primitiveSocketError' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocketLocalAddress: (in category 'primitives') -----
+ primSocketLocalAddress: socketID
+ 	"Return the local host address for this socket."
+ 
+ 	<primitive: 'primitiveSocketLocalAddress' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocketLocalAddressSize: (in category 'primitives-ipv6') -----
+ primSocketLocalAddressSize: handle
+ 
+ 	<primitive: 'primitiveSocketLocalAddressSize' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocketLocalPort: (in category 'primitives') -----
+ primSocketLocalPort: socketID
+ 	"Return the local port for this socket, or zero if no port has yet been assigned."
+ 
+ 	<primitive: 'primitiveSocketLocalPort' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocketReceiveDataAvailable: (in category 'primitives') -----
+ primSocketReceiveDataAvailable: socketID
+ 	"Return true if data may be available for reading from the current socket."
+ 
+ 	<primitive: 'primitiveSocketReceiveDataAvailable' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocketRemoteAddress: (in category 'primitives') -----
+ primSocketRemoteAddress: socketID
+ 	"Return the remote host address for this socket, or zero if no connection has been made."
+ 
+ 	<primitive: 'primitiveSocketRemoteAddress' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocketRemoteAddressSize: (in category 'primitives-ipv6') -----
+ primSocketRemoteAddressSize: handle
+ 
+ 	<primitive: 'primitiveSocketRemoteAddressSize' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocketRemotePort: (in category 'primitives') -----
+ primSocketRemotePort: socketID
+ 	"Return the remote port for this socket, or zero if no connection has been made."
+ 
+ 	<primitive: 'primitiveSocketRemotePort' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primSocketSendDone: (in category 'primitives') -----
+ primSocketSendDone: socketID
+ 	"Return true if there is no send in progress on the current socket."
+ 
+ 	<primitive: 'primitiveSocketSendDone' module: 'SocketPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: OldSocket>>primitiveOnlySupportsOneSemaphore (in category 'accessing') -----
+ primitiveOnlySupportsOneSemaphore
+ 	^primitiveOnlySupportsOneSemaphore!

Item was added:
+ ----- Method: OldSocket>>printOn: (in category 'printing') -----
+ printOn: aStream
+ 
+ 	super printOn: aStream.
+ 	aStream nextPutAll: '[', self statusString, ']'.
+ !

Item was added:
+ ----- Method: OldSocket>>readInto:startingAt: (in category 'sending-receiving') -----
+ readInto: aStringOrByteArray startingAt: aNumber 
+ 	"Read data into the given buffer starting at the given index and return the number of bytes received. Note the given buffer may be only partially filled by the received data."
+ 
+ 	(self waitForDataUntil: self class standardDeadline) 
+ 		ifFalse: [self error: 'receive timeout'].
+ 	^self 
+ 		primSocket: socketHandle
+ 		receiveDataInto: aStringOrByteArray
+ 		startingAt: aNumber
+ 		count: aStringOrByteArray size - aNumber + 1!

Item was added:
+ ----- Method: OldSocket>>readSemaphore (in category 'accessing') -----
+ readSemaphore
+ 	primitiveOnlySupportsOneSemaphore ifTrue: [^semaphore].
+ 	^readSemaphore!

Item was added:
+ ----- Method: OldSocket>>receiveDataInto: (in category 'sending-receiving') -----
+ receiveDataInto: aStringOrByteArray
+ 	"Receive data into the given buffer and return the number of bytes received. Note the given buffer may be only partially filled by the received data."
+ 
+ 	^ self primSocket: socketHandle
+ 		receiveDataInto: aStringOrByteArray
+ 		startingAt: 1
+ 		count: aStringOrByteArray size
+ !

Item was added:
+ ----- Method: OldSocket>>receiveDataInto:fromHost:port: (in category 'datagrams') -----
+ receiveDataInto: aStringOrByteArray fromHost: hostAddress port: portNumber
+ 	| datagram |
+ 	"Receive a UDP packet from the given hostAddress/portNumber, storing the data in the given buffer, and return the number of bytes received. Note the given buffer may be only partially filled by the received data."
+ 
+ 	primitiveOnlySupportsOneSemaphore ifTrue:
+ 		[self setPeer: hostAddress port: portNumber.
+ 		^self receiveDataInto: aStringOrByteArray].
+ 	[true] whileTrue: 
+ 		[datagram _ self receiveUDPDataInto: aStringOrByteArray.
+ 		((datagram at: 2) = hostAddress and: [(datagram at: 3) = portNumber]) 
+ 			ifTrue: [^datagram at: 1]
+ 			ifFalse: [^0]]!

Item was added:
+ ----- Method: OldSocket>>receiveUDPDataInto: (in category 'datagrams') -----
+ receiveUDPDataInto: aStringOrByteArray
+ 	"Receive UDP data into the given buffer and return the number of bytes received. Note the given buffer may be only partially filled by the received data. What is returned is an array, the first element is the bytes read, the second the sending bytearray address, the third the senders port, the fourth, true if more of the datagram awaits reading"
+ 
+ 	^ self primSocket: socketHandle
+ 		receiveUDPDataInto: aStringOrByteArray
+ 		startingAt: 1
+ 		count: aStringOrByteArray size
+ !

Item was added:
+ ----- Method: OldSocket>>register (in category 'registry') -----
+ register
+ 	^self class register: self!

Item was added:
+ ----- Method: OldSocket>>remotePort (in category 'accessing') -----
+ remotePort
+ 
+ 	^ self primSocketRemotePort: socketHandle
+ !

Item was added:
+ ----- Method: OldSocket>>remoteSocketAddress (in category 'ipv6') -----
+ remoteSocketAddress
+ 
+ 	| size addr |
+ 	size := self primSocketRemoteAddressSize: socketHandle.
+ 	addr := SocketAddress new: size.
+ 	self primSocket: socketHandle remoteAddressResult: addr.
+ 	^addr!

Item was added:
+ ----- Method: OldSocket>>semaphore (in category 'accessing') -----
+ semaphore
+ 	^semaphore!

Item was added:
+ ----- Method: OldSocket>>sendData: (in category 'sending-receiving') -----
+ sendData: aStringOrByteArray
+ 	"Send all of the data in the given array, even if it requires multiple calls to send it all. Return the number of bytes sent."
+ 
+ 	"An experimental version use on slow lines: Longer timeout and smaller writes to try to avoid spurious timeouts."
+ 
+ 	| bytesSent bytesToSend count |
+ 	bytesToSend _ aStringOrByteArray size.
+ 	bytesSent _ 0.
+ 	[bytesSent < bytesToSend] whileTrue: [
+ 		(self waitForSendDoneUntil: (Socket deadlineSecs: 60))
+ 			ifFalse: [ConnectionTimedOut signal: 'send data timeout; data not sent'].
+ 		count _ self primSocket: socketHandle
+ 			sendData: aStringOrByteArray
+ 			startIndex: bytesSent + 1
+ 			count: (bytesToSend - bytesSent min: 5000).
+ 		bytesSent _ bytesSent + count].
+ 
+ 	^ bytesSent
+ !

Item was added:
+ ----- Method: OldSocket>>sendData:count: (in category 'sending-receiving') -----
+ sendData: buffer count: n
+ 	"Send the amount of data from the given buffer"
+ 	| sent |
+ 	sent _ 0.
+ 	[sent < n] whileTrue:[
+ 		sent _ sent + (self sendSomeData: buffer startIndex: sent+1 count: (n-sent))].!

Item was added:
+ ----- Method: OldSocket>>sendData:toHost:port: (in category 'datagrams') -----
+ sendData: aStringOrByteArray toHost: hostAddress port: portNumber
+ 	"Send a UDP packet containing the given data to the specified host/port."
+ 
+ 	primitiveOnlySupportsOneSemaphore ifTrue:
+ 		[self setPeer: hostAddress port: portNumber.
+ 		^self sendData: aStringOrByteArray].
+ 	^self sendUDPData: aStringOrByteArray toHost: hostAddress port: portNumber!

Item was added:
+ ----- Method: OldSocket>>sendDone (in category 'queries') -----
+ sendDone
+ 	"Return true if the most recent send operation on this socket has completed."
+ 
+ 	socketHandle == nil ifTrue: [^ false].
+ 	^ self primSocketSendDone: socketHandle
+ !

Item was added:
+ ----- Method: OldSocket>>sendSomeData: (in category 'sending-receiving') -----
+ sendSomeData: aStringOrByteArray
+ 	"Send as much of the given data as possible and answer the number of bytes actually sent."
+ 	"Note: This operation may have to be repeated multiple times to send a large amount of data."
+ 
+ 	^ self
+ 		sendSomeData: aStringOrByteArray
+ 		startIndex: 1
+ 		count: aStringOrByteArray size!

Item was added:
+ ----- Method: OldSocket>>sendSomeData:startIndex: (in category 'sending-receiving') -----
+ sendSomeData: aStringOrByteArray startIndex: startIndex
+ 	"Send as much of the given data as possible starting at the given index. Answer the number of bytes actually sent."
+ 	"Note: This operation may have to be repeated multiple times to send a large amount of data."
+ 
+ 	^ self
+ 		sendSomeData: aStringOrByteArray
+ 		startIndex: startIndex
+ 		count: (aStringOrByteArray size - startIndex + 1)!

Item was added:
+ ----- Method: OldSocket>>sendSomeData:startIndex:count: (in category 'sending-receiving') -----
+ sendSomeData: aStringOrByteArray startIndex: startIndex count: count 
+ 	"Send up to count bytes of the given data starting at the given index. Answer the number of bytes actually sent."
+ 
+ 	"Note: This operation may have to be repeated multiple times to send a large amount of data."
+ 
+ 	| bytesSent |
+ 	(self waitForSendDoneUntil: (self class deadlineSecs: 20)) 
+ 		ifTrue: 
+ 			[bytesSent := self 
+ 						primSocket: socketHandle
+ 						sendData: aStringOrByteArray
+ 						startIndex: startIndex
+ 						count: count]
+ 		ifFalse: [self error: 'send data timeout; data not sent'].
+ 	^bytesSent!

Item was added:
+ ----- Method: OldSocket>>sendUDPData:toHost:port: (in category 'datagrams') -----
+ sendUDPData: aStringOrByteArray toHost: hostAddress port: portNumber 
+ 	"Send a UDP packet containing the given data to the specified host/port."
+ 
+ 	| bytesToSend bytesSent count |
+ 	bytesToSend := aStringOrByteArray size.
+ 	bytesSent := 0.
+ 	[bytesSent < bytesToSend] whileTrue: 
+ 			[(self waitForSendDoneUntil: (self class deadlineSecs: 20)) 
+ 				ifFalse: [self error: 'send data timeout; data not sent'].
+ 			count := self 
+ 						primSocket: socketHandle
+ 						sendUDPData: aStringOrByteArray
+ 						toHost: hostAddress
+ 						port: portNumber
+ 						startIndex: bytesSent + 1
+ 						count: bytesToSend - bytesSent.
+ 			bytesSent := bytesSent + count].
+ 	^bytesSent!

Item was added:
+ ----- Method: OldSocket>>setOption:value: (in category 'other') -----
+ setOption: aName value: aValue 
+ 	| value |
+ 	"setup options on this socket, see Unix man pages for values for 
+ 	sockets, IP, TCP, UDP. IE SO_KEEPALIVE
+ 	returns an array, element one is the error number
+ 	element two is the resulting of the negotiated value.
+ 	See getOption for list of keys"
+ 
+ 	(socketHandle == nil or: [self isValid not])
+ 		ifTrue: [self error: 'Socket status must valid before setting an option'].
+ 	value _ aValue asString.
+ 	aValue == true ifTrue: [value _ '1'].
+ 	aValue == false ifTrue: [value _ '0'].
+ 	^ self primSocket: socketHandle setOption: aName value: value!

Item was added:
+ ----- Method: OldSocket>>setPeer:port: (in category 'datagrams') -----
+ setPeer: hostAddress port: port
+ 	"Set the default send/recv address."
+ 
+ 	self primSocket: socketHandle connectTo: hostAddress port: port.
+ !

Item was added:
+ ----- Method: OldSocket>>setPort: (in category 'datagrams') -----
+ setPort: port
+ 	"Associate a local port number with a UDP socket.  Not applicable to TCP sockets."
+ 
+ 	self primSocket: socketHandle setPort: port.
+ !

Item was added:
+ ----- Method: OldSocket>>socketError (in category 'queries') -----
+ socketError
+ 	^self primSocketError: socketHandle!

Item was added:
+ ----- Method: OldSocket>>socketHandle (in category 'accessing') -----
+ socketHandle
+ 	^socketHandle!

Item was added:
+ ----- Method: OldSocket>>statusString (in category 'queries') -----
+ statusString
+ 	"Return a string describing the status of this socket."
+ 
+ 	| status |
+ 	socketHandle == nil ifTrue: [^ 'destroyed'].
+ 	status _ self primSocketConnectionStatus: socketHandle.
+ 	status = InvalidSocket ifTrue: [^ 'invalidSocketHandle'].
+ 	status = Unconnected ifTrue: [^ 'unconnected'].
+ 	status = WaitingForConnection ifTrue: [^ 'waitingForConnection'].
+ 	status = Connected ifTrue: [^ 'connected'].
+ 	status = OtherEndClosed ifTrue: [^ 'otherEndClosedButNotThisEnd'].
+ 	status = ThisEndClosed ifTrue: [^ 'thisEndClosedButNotOtherEnd'].
+ 	^ 'unknown socket status'
+ !

Item was added:
+ ----- Method: OldSocket>>unregister (in category 'registry') -----
+ unregister
+ 	^self class unregister: self!

Item was added:
+ ----- Method: OldSocket>>waitForConnectionFor:ifTimedOut: (in category 'waiting') -----
+ waitForConnectionFor: timeout ifTimedOut: timeoutBlock
+ 	"Wait up until the given deadline for a connection to be established. Return true if it is established by the deadline, false if not."
+ 
+ 	| status deadline |
+ 	deadline := Socket deadlineSecs: timeout.
+ 	status _ self primSocketConnectionStatus: socketHandle.
+ 	[(status = WaitingForConnection) and: [Time millisecondClockValue < deadline]]
+ 		whileTrue: [
+ 			semaphore waitTimeoutMSecs: (deadline - Time millisecondClockValue).
+ 			status _ self primSocketConnectionStatus: socketHandle].
+ 
+ 	status = Connected ifFalse: [^timeoutBlock value]
+ !

Item was added:
+ ----- Method: OldSocket>>waitForConnectionUntil: (in category 'waiting') -----
+ waitForConnectionUntil: deadline
+ 	"Wait up until the given deadline for a connection to be established. Return true if it is established by the deadline, false if not."
+ 
+ 	| status |
+ 	status _ self primSocketConnectionStatus: socketHandle.
+ 	[(status = WaitingForConnection) and: [Time millisecondClockValue < deadline]]
+ 		whileTrue: [
+ 			semaphore waitTimeoutMSecs: (deadline - Time millisecondClockValue).
+ 			status _ self primSocketConnectionStatus: socketHandle].
+ 
+ 	^ status = Connected
+ !

Item was added:
+ ----- Method: OldSocket>>waitForDataUntil: (in category 'waiting') -----
+ waitForDataUntil: deadline
+ 	"Wait up until the given deadline for data to arrive. Return true if data arrives by the deadline, false if not."
+ 
+ 	| dataArrived |
+ 	[self isConnected & 
+ 	 (dataArrived _ self primSocketReceiveDataAvailable: socketHandle) not
+ 			"Connection end and final data can happen fast, so test in this order"
+ 		and: [Time millisecondClockValue < deadline]] whileTrue: [
+ 			self readSemaphore waitTimeoutMSecs: (deadline - Time millisecondClockValue)].
+ 
+ 	^ dataArrived
+ !

Item was added:
+ ----- Method: OldSocket>>waitForDisconnectionUntil: (in category 'waiting') -----
+ waitForDisconnectionUntil: deadline
+ 	"Wait up until the given deadline for the the connection to be broken. Return true if it is broken by the deadline, false if not."
+ 	"Note: The client should know the the connect is really going to be closed (e.g., because he has called 'close' to send a close request to the other end) before calling this method.
+ JMM 00/5/17 note that other end can close which will terminate wait"
+ 
+ 	| extraBytes status |
+ 	extraBytes _ 0.
+ 	status _ self primSocketConnectionStatus: socketHandle.
+ 	[((status = Connected) or: [(status = ThisEndClosed)]) and:
+ 	 [Time millisecondClockValue < deadline]] whileTrue: [
+ 		self dataAvailable
+ 			ifTrue: [extraBytes _ extraBytes + self discardReceivedData].
+ 		semaphore waitTimeoutMSecs: (deadline - Time millisecondClockValue).
+ 		status _ self primSocketConnectionStatus: socketHandle].
+ 
+ 	extraBytes > 0
+ 		ifTrue: [self inform: 'Discarded ', extraBytes printString, ' bytes while closing connection.'].
+ 
+ 	^ status ~= Connected
+ !

Item was added:
+ ----- Method: OldSocket>>waitForSendDoneUntil: (in category 'waiting') -----
+ waitForSendDoneUntil: deadline
+ 	"Wait up until the given deadline for the current send operation to complete. Return true if it completes by the deadline, false if not."
+ 
+ 	| sendDone |
+ 	[self isConnected & (sendDone _ self primSocketSendDone: socketHandle) not
+ 			"Connection end and final data can happen fast, so test in this order"
+ 		and: [Time millisecondClockValue < deadline]] whileTrue: [
+ 			self writeSemaphore waitTimeoutMSecs: (deadline - Time millisecondClockValue)].
+ 
+ 	^ sendDone!

Item was added:
+ ----- Method: OldSocket>>writeSemaphore (in category 'accessing') -----
+ writeSemaphore
+ 	primitiveOnlySupportsOneSemaphore ifTrue: [^semaphore].
+ 	^writeSemaphore!

Item was added:
+ ----- Method: OrderedCollection>>errorConditionNotSatisfied (in category '*Etoys-Squeakland-private') -----
+ errorConditionNotSatisfied
+ 
+ 	self error: 'no element satisfies condition'!

Item was added:
+ ----- Method: OrderedCollection>>grow (in category '*Etoys-Squeakland-adding') -----
+ grow
+ 	"Become larger. Typically, a subclass has to override this if the subclass
+ 	adds instance variables."
+ 	| newArray |
+ 	newArray _ Array new: self size + self growSize.
+ 	newArray replaceFrom: 1 to: array size with: array startingAt: 1.
+ 	array _ newArray!

Item was added:
+ ----- Method: OrderedCollection>>growSize (in category '*Etoys-Squeakland-adding') -----
+ growSize
+ 	^ array size max: 2!

Item was added:
+ Model subclass: #PDA
+ 	instanceVariableNames: 'userCategories allPeople allEvents recurringEvents allToDoItems allNotes date category currentItem currentItemText currentItemSelection categoryList categoryListIndex peopleList peopleListIndex scheduleList scheduleListIndex toDoList toDoListIndex notesList notesListIndex dateButtonPressed viewDescriptionOnly'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-PDA'!
+ 
+ !PDA commentStamp: '<historical>' prior: 0!
+ PDA help text...
+ A lot about the PDA should be obvious just by opening one up and playing with the sample data.  The PDA holds a complete database of people, events, to-do items and notes.  The date and keyword selected determine which records are visible at any given time.
+ 
+ All records
+ All records in the database have a number of pre-allocated fields, and these are displayed in the obvious manner in the current item pane at the bottom, when the record is selected.  Care must be taken to enter only valid data as the contents of any field.  This is usually simple but, for instance, matching string quotes can be a problem (embedded string quotes must be doubled).
+ 
+ Any item may be augmented by any number of fields, provided that the field names do not conflict with existing ones, and that the contents are valid Squeak objects.
+ 
+ The description field may often carry a long body of text so, for this reason, a special feature is provided for viewing only the description of the current item.  This makes it a lot easier to read long notes (like this one), and it saves the user from worrying about matching quotes and other punctuation.  Sorry it's a mode -- use the menu of the bottom pane to switch modes.
+ 
+ People
+ Since the name field is not split into first, middle, last as in some databases, you are encouraged to adopt the following format:
+ 	Lastname, First I., Jr. (Nickname) (&Spousename)
+ which allows for useful processing for invitations and the like.
+ 
+ ToDoItems
+ ToDo items are designed not to be removed, but only to be marked done.  This allows the database to be browsed retroactively, with the to-do items appearing and disappearing on the dates the tasks were introduced and completed respectively.  Note that toDo items have a deadline field whose obvious associated semantics (see alarms) have not yet been implemented.
+ 
+ Schedule
+ Scedule items are relatively simple.  It is intended that if duration is specified, and that if time+duration overlaps ensuing events, that the ensuing events will be show in red or someting like that.  Alarms have not yet been implemented, but they will accept an integer field equal to the number of minutes prior to event time that the alarm should appear.  Presumably an alarm will apppear as a new object on the screen that announces the event, sounds a continuing audible sound, and allows easy dismissal by clicking or keystroke.
+ 
+ A number of short forms are allowed for the time field, such as '4p' asTime.
+ An event with time = nil will appear with dashes at the beginning of the day.
+ 
+ RecurringEvents
+ Recurring events are treated specially.  Each master event is consulted to generate derivative events in the schedule for any given day.  You can edit the derivative events, at which point they will become permanent events just like any other.  An unedited recurring event is a virtual object -- if you edit the master, its derivative copies may disappear from one time and reappear at another.  For this reason it is recommended that you never alter the date of a recurring event.  Instead, declare its last date, causing an end to that series, and create another recurring event for the new schedule if desired.  In this manner all the past schedule will continue to appear as it did when it was current.
+ 
+ To examine or alter recurring events, select the 'recurring' category (this will need further filtering for large databases).  The currently supported recurrence rules include
+ 	#eachDay - for example, a 2-week vacation (give first and last dates).
+ 	#dayOfWeek - for example, every Thursday
+ 	#dayOfMonth - for example, on the first day of every month
+ 	#dateOfYear - for example, birthdays and many holidays
+ 	#nthWeekdayOfMonth - for example, the second Tuesday of every month
+ 	#nthWeekdayOfMonthEachYear - for example, Thanksgiving
+ (The Squeak PDA does not support the recurrence rule for Easter Sunday ;-).
+ 
+ Notes
+ Notes are simple a place to capture thoughts and information relevant to the different areas of your life while you are in the simple planning mood inspired by using a PDA.  The ability to view the current item's description only is especially useful for notes.
+ 
+ Spawn Entire Month
+ While this feature (accessible from bottom pane menu) is very crude and does not offer interaction, its real purpose is for printing.  Expand the spawned window to full screen, use the morph menu to choose 'print PS to File...', and then send the resulting .eps file to your printer.  (At the time of this writing portrait and landscpe options were reversed ;-).!

Item was added:
+ ----- Method: PDA>>acceptCurrentItemText: (in category 'currentItem') -----
+ acceptCurrentItemText: aText
+ 	"Accept into the current item from the text provided, and update lists accordingly"
+ 
+ 	currentItem ifNil:
+ 		[self inform: 'Can''t accept -- no item is selected'. ^ false].
+ 	viewDescriptionOnly ifTrue:
+ 		[currentItem description: aText string. ^ true].
+ 
+ 	currentItem readFrom: aText.
+ 	(currentItem isKindOf: PDAEvent) ifTrue: [self updateScheduleList].
+ 	(currentItem isMemberOf: PDAToDoItem) ifTrue: [self updateToDoList].
+ 	(currentItem isMemberOf: PDAPerson) ifTrue: [self updatePeopleList].
+ 	(currentItem isMemberOf: PDARecord) ifTrue: [self updateNotesList].
+ 	^ true!

Item was added:
+ ----- Method: PDA>>addEvent (in category 'schedule') -----
+ addEvent
+ 	| newEvent |
+ 	newEvent _ PDAEvent new key: self categorySelected; date: date;
+ 						time: (Time readFromString: '7 am');
+ 						description: 'new event'.
+ 	allEvents _ allEvents copyWith: newEvent.
+ 	self currentItem: newEvent.
+ 	self updateScheduleList!

Item was added:
+ ----- Method: PDA>>addNote (in category 'notes') -----
+ addNote
+ 	| newNote |
+ 	newNote _ PDARecord new key: self categorySelected; description: 'new note'.
+ 	allNotes _ allNotes copyWith: newNote.
+ 	self currentItem: newNote.
+ 	self updateNotesList!

Item was added:
+ ----- Method: PDA>>addPerson (in category 'people') -----
+ addPerson
+ 	| newPerson |
+ 	newPerson _ PDAPerson new key: self categorySelected; name: 'Last, First'.
+ 	allPeople _ allPeople copyWith: newPerson.
+ 	self currentItem: newPerson.
+ 	self updatePeopleList!

Item was added:
+ ----- Method: PDA>>addRecurringEvent (in category 'schedule') -----
+ addRecurringEvent
+ 	| newEvent |
+ 	newEvent _ PDARecurringEvent new key: self categorySelected;
+ 						firstDate: date; recurrence: PDARecurringEvent chooseRecurrence;
+ 						description: 'recurring event'.
+ 	newEvent key = 'recurring' ifTrue: [newEvent key: 'all'].
+ 	newEvent recurrence == #eachDay ifTrue: [newEvent lastDate: (date addDays: 1)].
+ 	recurringEvents _ recurringEvents copyWith: newEvent.
+ 	self currentItem: newEvent.
+ 	self updateScheduleList!

Item was added:
+ ----- Method: PDA>>addToDoItem (in category 'to do') -----
+ addToDoItem
+ 	| newToDoItem |
+ 	newToDoItem _ PDAToDoItem new key: self categorySelected; description: 'new item to do';
+ 					dayPosted: Date today; priority: 1.
+ 	allToDoItems _ allToDoItems copyWith: newToDoItem.
+ 	self currentItem: newToDoItem.
+ 	self updateToDoList!

Item was added:
+ ----- Method: PDA>>categoryChoices (in category 'category') -----
+ categoryChoices
+ 	"Return a list for the popup chooser"
+ 	| special |
+ 	special _ {'all'. 'recurring'. nil}.
+ 	(special includes: category) ifTrue:
+ 		[^ special , userCategories , {nil. 'add new key'}].
+ 	^ special , userCategories , {nil. 'remove ' , self categorySelected. 'rename ' , self categorySelected. nil. 'add new key'}!

Item was added:
+ ----- Method: PDA>>categorySelected (in category 'category') -----
+ categorySelected
+ 
+ 	^ category ifNil: ['all']
+ !

Item was added:
+ ----- Method: PDA>>chooseFrom:categoryItem: (in category 'category') -----
+ chooseFrom: chooserMorph categoryItem: item
+ 
+ 	| newKey menu |
+ 	newKey _ item.
+ 	self okToChange ifFalse: [^ self].
+ 	(item = 'add new key') ifTrue:
+ 		[newKey _ FillInTheBlank request: 'New key to use'
+ 						initialAnswer: self categorySelected.
+ 		newKey isEmpty ifTrue: [^ self].
+ 		(userCategories includes: newKey) ifTrue: [^ self].
+ 		userCategories _ (userCategories copyWith: newKey) sort].
+ 	(item beginsWith: 'remove ') ifTrue:
+ 		[(self confirm: 'Removal of this category will cause all items formerly
+ categorized as ''' , self categorySelected , ''' to be reclassified as ''all''.
+ Is this really what you want to do?
+ [unless there are very few, choose ''no'']')
+ 			ifFalse: [^ self].
+ 		self rekeyAllRecordsFrom: self categorySelected to: 'all'.
+ 		userCategories _ userCategories copyWithout: self categorySelected.
+ 		newKey _ 'all'].
+ 	(item beginsWith: 'rename ') ifTrue:
+ 		[menu _ CustomMenu new.
+ 		userCategories do: [:key | menu add: key action: key].
+ 		newKey _ menu startUpWithCaption: 'Please select the new key for
+ items now categorized as ''' , self categorySelected , '''.'.
+ 		newKey ifNil: [^ self].
+ 		(self confirm: 'Renaming this category will cause all items formerly
+ categorized as ''' , self categorySelected , ''' to be reclassified as ''' , newKey , '''.
+ Is this really what you want to do?')
+ 			ifFalse: [^ self].
+ 		self rekeyAllRecordsFrom: self categorySelected to: newKey.
+ 		userCategories _ userCategories copyWithout: self categorySelected].
+ 	self selectCategory: newKey.
+ 	chooserMorph contentsClipped: newKey!

Item was added:
+ ----- Method: PDA>>clearUserEditFlag (in category 'currentItem') -----
+ clearUserEditFlag
+ 	"Clear the hasUnacceptedEdits flag in all my dependent views."
+ 
+ 	self changed: #clearUserEdits!

Item was added:
+ ----- Method: PDA>>currentItem (in category 'currentItem') -----
+ currentItem
+ 	"Return the value of currentItem"
+ 	currentItem ifNil: [^ 'No item is selected.'].
+ 	^ currentItem!

Item was added:
+ ----- Method: PDA>>currentItem: (in category 'currentItem') -----
+ currentItem: newValue
+ 	"Assign newValue to currentItem."
+ 
+ 	currentItem class == newValue class ifFalse:
+ 		["get rid of this hideous hack"
+ 		(currentItem isMemberOf: PDAEvent) ifTrue: [self scheduleListIndex: 0].
+ 		(currentItem isMemberOf: PDAToDoItem) ifTrue: [self toDoListIndex: 0].
+ 		(currentItem isMemberOf: PDAPerson) ifTrue: [self peopleListIndex: 0].
+ 		(currentItem isMemberOf: PDARecord) ifTrue: [self notesListIndex: 0]].
+ 	currentItem _ newValue.
+ 	self changed: #currentItemText!

Item was added:
+ ----- Method: PDA>>currentItemMenu: (in category 'currentItem') -----
+ currentItemMenu: aMenu
+ 	| donorMenu labels |
+ 	viewDescriptionOnly
+ 		ifTrue: [aMenu add: 'view entire records' target: self selector: #toggleDescriptionMode]
+ 		ifFalse: [aMenu add: 'view descriptions only' target: self selector: #toggleDescriptionMode].
+ 	aMenu addLine.
+ 	aMenu add: 'save database' target: self selector: #saveDatabase.
+ 	aMenu add: 'load database from file...' target: self selector: #loadDatabase.
+ 	aMenu add: 'spawn entire month' target: self selector: #openMonthView.
+ 	aMenu addLine.
+ 	aMenu add: 'accept (s)' target: self selector: #accept.
+ 	aMenu add: 'cancel (l)' target: self selector: #cancel.
+ 	aMenu addLine.
+ 	donorMenu _ ParagraphEditor yellowButtonMenu.
+ 	labels _ donorMenu labelString findTokens: String cr.
+ 	aMenu labels: (labels allButLast: 4) lines: donorMenu lineArray selections: donorMenu selections.
+ 	^ aMenu!

Item was added:
+ ----- Method: PDA>>currentItemSelection (in category 'currentItem') -----
+ currentItemSelection
+ 	"Return the value of currentItemSelection"
+ 	currentItemSelection ifNil: [^ 1 to: 0].
+ 	^ currentItemSelection!

Item was added:
+ ----- Method: PDA>>currentItemSelection: (in category 'currentItem') -----
+ currentItemSelection: newValue
+ 	"Assign newValue to currentItemSelection."
+ 
+ 	currentItemSelection _ newValue.!

Item was added:
+ ----- Method: PDA>>currentItemText (in category 'currentItem') -----
+ currentItemText
+ 
+ 	currentItem ifNil: [^ 'no item is selected'].
+ 	viewDescriptionOnly
+ 		ifTrue: [currentItem description ifNil:
+ 					[^ 'No description has yet been entered for this item'].
+ 				^ currentItem description asText]
+ 		ifFalse: [^ currentItem asText]!

Item was added:
+ ----- Method: PDA>>declareItemDone (in category 'to do') -----
+ declareItemDone
+ 	| report |
+ 	report := FillInTheBlank 
+ 				request: 'This item will be declared done as of
+ ' , date printString 
+ 						, '.
+ Please give a short summary of status'
+ 				initialAnswer: 'Completed.'.
+ 	(report isNil or: [report isEmpty]) ifTrue: [^self].
+ 	currentItem
+ 		dayDone: date;
+ 		result: report.
+ 	self currentItem: currentItem!

Item was added:
+ ----- Method: PDA>>declareLastDate (in category 'schedule') -----
+ declareLastDate
+ 	(self confirm: 'Please confirm termination of this event as of
+ ' , date printString , '.')
+ 		ifFalse: [^ self].
+ 	currentItem lastDate: date.
+ 	self currentItem: currentItem
+ !

Item was added:
+ ----- Method: PDA>>declarelastDate (in category 'schedule') -----
+ declarelastDate
+ 	(self confirm: 'Please confirm termination of this event as of
+ ' , date printString , '.')
+ 		ifFalse: [^ self].
+ 	currentItem lastDate: date.
+ 	self currentItem: currentItem
+ !

Item was added:
+ ----- Method: PDA>>initialize (in category 'initialization') -----
+ initialize
+ 	viewDescriptionOnly _ false.
+ 	self userCategories: self sampleCategoryList
+ 		allPeople: self samplePeopleList
+ 		allEvents: self sampleScheduleList
+ 		recurringEvents: self sampleRecurringEventsList
+ 		allToDoItems: self sampleToDoList
+ 		allNotes: self sampleNotes
+ 		dateSelected: Date today
+ 	!

Item was added:
+ ----- Method: PDA>>labelString (in category 'initialization') -----
+ labelString
+ 
+ 	| today |
+ 	today _ Date today.
+ 	^ String streamContents:
+ 		[:s | s nextPutAll: today weekday; space.
+ 		Time now print24: false showSeconds: false on: s.
+ 		s nextPutAll: '  --  '.
+ 		s nextPutAll: today monthName; space; print: today dayOfMonth;
+ 			nextPutAll: ', '; print: today year]!

Item was added:
+ ----- Method: PDA>>loadDatabase (in category 'initialization') -----
+ loadDatabase
+ 	| aName aFileStream list |
+ 	aName _ Utilities chooseFileWithSuffixFromList: #('.pda' '.pda.gz' ) withCaption: 'Choose a file to load'.
+ 	aName
+ 		ifNil: [^ self].
+ 	"User made no choice"
+ 	aName == #none
+ 		ifTrue: [^ self inform: 'Sorry, no suitable files found
+ (names should end with .data or .data.gz)'].
+ 	aFileStream _ FileStream oldFileNamed: aName.
+ 	list _ aFileStream fileInObjectAndCode.
+ 	userCategories _ list first.
+ 	allPeople _ list second.
+ 	allEvents _ list third.
+ 	recurringEvents _ list fourth.
+ 	allToDoItems _ list fifth.
+ 	allNotes _ list sixth.
+ 	date _ Date today.
+ 	self selectCategory: 'all'!

Item was added:
+ ----- Method: PDA>>mergeDatabase (in category 'initialization') -----
+ mergeDatabase
+ 	| aName aFileStream list |
+ 	aName _ Utilities chooseFileWithSuffixFromList: #('.pda' '.pda.gz' ) withCaption: 'Choose a file to load'.
+ 	aName
+ 		ifNil: [^ self].
+ 	"User made no choice"
+ 	aName == #none
+ 		ifTrue: [^ self inform: 'Sorry, no suitable files found
+ (names should end with .data or .data.gz)'].
+ 	aFileStream _ FileStream oldFileNamed: aName.
+ 	list _ aFileStream fileInObjectAndCode.
+ 	userCategories _ (list first , userCategories) asSet asArray sort.
+ 	allPeople _ (list second , allPeople) asSet asArray sort.
+ 	allEvents _ (list third , allEvents) asSet asArray sort.
+ 	recurringEvents _ (list fourth , recurringEvents) asSet asArray sort.
+ 	allToDoItems _ (list fifth , allToDoItems) asSet asArray sort.
+ 	allNotes _ ((list sixth)
+ 				, allNotes) asSet asArray sort.
+ 	date _ Date today.
+ 	self selectCategory: 'all'!

Item was added:
+ ----- Method: PDA>>notesList (in category 'notes') -----
+ notesList
+ 	"Return the value of notesList"
+ 	^ notesList!

Item was added:
+ ----- Method: PDA>>notesListIndex (in category 'notes') -----
+ notesListIndex
+ 	"Return the value of notesListIndex"
+ 	^ notesListIndex!

Item was added:
+ ----- Method: PDA>>notesListIndex: (in category 'notes') -----
+ notesListIndex: newValue
+ 	"Assign newValue to notesListIndex."
+ 
+ 	notesListIndex = newValue ifTrue: [^ self].
+ 	self okToChange ifFalse: [^ self].
+ 	notesListIndex _ newValue.
+ 	self currentItem: (notesListIndex ~= 0
+ 						ifTrue: [notesList at: notesListIndex]
+ 						ifFalse: [nil]).
+ 	self changed: #notesListIndex.!

Item was added:
+ ----- Method: PDA>>notesListItems (in category 'notes') -----
+ notesListItems
+ 
+ 	^ notesList collect: [:p | p asListItem]!

Item was added:
+ ----- Method: PDA>>notesMenu: (in category 'notes') -----
+ notesMenu: aMenu
+ 
+ 	aMenu add: 'add new note' target: self selector: #addNote.
+ 	notesListIndex > 0 ifTrue:
+ 		[aMenu add: 'remove note' target: self selector: #removeNote].
+ 	^ aMenu!

Item was added:
+ ----- Method: PDA>>okToChange (in category 'updating') -----
+ okToChange
+ 
+ 	self canDiscardEdits ifTrue: [^ true].
+ 	self changed: #wantToChange.  "Solicit cancel from view"
+ 	^ self canDiscardEdits
+ !

Item was added:
+ ----- Method: PDA>>openAsMorphIn: (in category 'initialization') -----
+ openAsMorphIn: window  "PDA new openAsMorph openInWorld"
+ 	"Create a pluggable version of all the morphs for a Browser in Morphic"
+ 	| dragNDropFlag paneColor chooser |
+ 	window color: Color black.
+ 	paneColor _ (Color r: 0.6 g: 1.0 b: 0.0).
+ 	window model: self.
+ 	Preferences alternativeWindowLook ifTrue:[
+ 		window color: Color white.
+ 		window paneColor: paneColor].
+ 	dragNDropFlag _ Preferences browseWithDragNDrop.
+ 	window addMorph: ((PluggableListMorph on: self list: #peopleListItems
+ 			selected: #peopleListIndex changeSelected: #peopleListIndex:
+ 			menu: #peopleMenu: keystroke: #peopleListKey:from:) enableDragNDrop: dragNDropFlag)
+ 		frame: (0 at 0 corner: 0.3 at 0.25).
+ 	window addMorph: ((chooser _ PDAChoiceMorph new color: paneColor) contentsClipped: 'all';
+ 			target: self; actionSelector: #chooseFrom:categoryItem:; arguments: {chooser};
+ 			getItemsSelector: #categoryChoices)
+ 		frame: (0 at 0.25 corner: 0.3 at 0.3).
+ 	window addMorph: ((MonthMorph newWithModel: self) color: paneColor; extent: 148 at 109)
+ 		frame: (0.3 at 0 corner: 0.7 at 0.3).
+ 	window addMorph: (PDAClockMorph new color: paneColor;
+ 						faceColor: (Color r: 0.4 g: 0.8 b: 0.6))  "To match monthMorph"
+ 		frame: (0.7 at 0 corner: 1.0 at 0.3).
+ 
+ 	window addMorph: ((PluggableListMorph on: self list: #toDoListItems
+ 			selected: #toDoListIndex changeSelected: #toDoListIndex:
+ 			menu: #toDoMenu: keystroke: #toDoListKey:from:) enableDragNDrop: dragNDropFlag)
+ 		frame: (0 at 0.3 corner: 0.3 at 0.7).
+ 	window addMorph: ((PluggableListMorph on: self list: #scheduleListItems
+ 			selected: #scheduleListIndex changeSelected: #scheduleListIndex:
+ 			menu: #scheduleMenu: keystroke: #scheduleListKey:from:) enableDragNDrop: dragNDropFlag)
+ 		frame: (0.3 at 0.3 corner: 0.7 at 0.7).
+ 	window addMorph: ((PluggableListMorph on: self list: #notesListItems
+ 			selected: #notesListIndex changeSelected: #notesListIndex:
+ 			menu: #notesMenu: keystroke: #notesListKey:from:) enableDragNDrop: dragNDropFlag)
+ 		frame: (0.7 at 0.3 corner: 1 at 0.7).
+ 
+ 	window addMorph: (PluggableTextMorph on: self
+ 			text: #currentItemText accept: #acceptCurrentItemText:
+ 			readSelection: #currentItemSelection menu: #currentItemMenu:)
+ 		frame: (0 at 0.7 corner: 1 at 1).
+ 	Preferences alternativeWindowLook ifFalse:[
+ 		window firstSubmorph color: paneColor.
+ 	].
+ 	window updatePaneColors.
+ 	window step.
+ 	^ window!

Item was added:
+ ----- Method: PDA>>openMonthView (in category 'initialization') -----
+ openMonthView
+ 	| row month col paneExtent window paneColor nRows |
+ 	month _ date notNil
+ 		ifTrue: [date month]
+ 		ifFalse: ["But... it's here somewhere..."
+ 				((self dependents detect: [:m | m isKindOf: PDAMorph])
+ 					findA: MonthMorph) month].
+ 	window _ SystemWindow labelled: month printString.
+ 	paneColor _ Color transparent.
+ 	window color: (Color r: 0.968 g: 1.0 b: 0.355).
+ 	nRows _ 0.  month eachWeekDo: [:w | nRows _ nRows + 1].
+ 	paneExtent _ ((1.0/7) @ (1.0/nRows)).
+ 	row _ 0.
+ 	month eachWeekDo:
+ 		[:week | col _ 0.
+ 		week do:
+ 			[:day | day month = month ifTrue:
+ 				[window addMorph: ((PluggableListMorph on: self list: nil
+ 						selected: nil changeSelected: nil menu: nil keystroke: nil)
+ 							list: {(day dayOfMonth printString , '  ' , day weekday) asText allBold}
+ 								, (self scheduleListForDay: day))
+ 					frame: (paneExtent * (col at row) extent: paneExtent)].
+ 			col _ col + 1].
+ 		row _ row + 1].
+ 
+ 	window firstSubmorph color: paneColor.
+ 	window updatePaneColors.
+ 	window openInWorld!

Item was added:
+ ----- Method: PDA>>peopleList (in category 'people') -----
+ peopleList
+ 	"Return the value of peopleList"
+ 	^ peopleList!

Item was added:
+ ----- Method: PDA>>peopleListIndex (in category 'people') -----
+ peopleListIndex
+ 	"Return the value of peopleListIndex"
+ 	^ peopleListIndex!

Item was added:
+ ----- Method: PDA>>peopleListIndex: (in category 'people') -----
+ peopleListIndex: newValue
+ 	"Assign newValue to peopleListIndex."
+ 
+ 	peopleListIndex = newValue ifTrue: [^ self].
+ 	self okToChange ifFalse: [^ self].
+ 	peopleListIndex _ newValue.
+ 	self currentItem: (peopleListIndex ~= 0
+ 						ifTrue: [peopleList at: peopleListIndex]
+ 						ifFalse: [nil]).
+ 	self changed: #peopleListIndex.!

Item was added:
+ ----- Method: PDA>>peopleListItems (in category 'people') -----
+ peopleListItems
+ 
+ 	^ peopleList collect: [:p | p asListItem]!

Item was added:
+ ----- Method: PDA>>peopleMenu: (in category 'people') -----
+ peopleMenu: aMenu
+ 
+ 	aMenu add: 'add new person' target: self selector: #addPerson.
+ 	peopleListIndex > 0 ifTrue:
+ 		[aMenu add: 'remove person' target: self selector: #removePerson].
+ 	^ aMenu!

Item was added:
+ ----- Method: PDA>>perform:orSendTo: (in category 'menus') -----
+ perform: selector orSendTo: otherTarget
+ 	"This should be the default in Object"
+ 
+ 	(self respondsTo: selector)
+ 		ifTrue: [^ self perform: selector]
+ 		ifFalse: [^ otherTarget perform: selector]!

Item was added:
+ ----- Method: PDA>>rekeyAllRecordsFrom:to: (in category 'initialization') -----
+ rekeyAllRecordsFrom: oldKey to: newKey
+ 
+ 	allPeople do: [:r | r rekey: oldKey to: newKey].
+ 	allEvents do: [:r | r rekey: oldKey to: newKey].
+ 	recurringEvents do: [:r | r rekey: oldKey to: newKey].
+ 	allToDoItems do: [:r | r rekey: oldKey to: newKey].
+ 	allNotes do: [:r | r rekey: oldKey to: newKey].
+ !

Item was added:
+ ----- Method: PDA>>removeEvent (in category 'schedule') -----
+ removeEvent
+ 
+ 	(currentItem isKindOf: PDARecurringEvent)
+ 	ifTrue: [(self confirm:
+ 'Rather than remove a recurring event, it is
+ better to declare its last day to keep the record.
+ Do you still wish to remove it?')
+ 				ifFalse: [^ self].
+ 			recurringEvents _ recurringEvents copyWithout: currentItem]
+ 	ifFalse: [allEvents _ allEvents copyWithout: currentItem].
+ 	self currentItem: nil.
+ 	self updateScheduleList.
+ !

Item was added:
+ ----- Method: PDA>>removeNote (in category 'notes') -----
+ removeNote
+ 
+ 	allNotes _ allNotes copyWithout: currentItem.
+ 	self currentItem: nil.
+ 	self updateNotesList.
+ !

Item was added:
+ ----- Method: PDA>>removePerson (in category 'people') -----
+ removePerson
+ 
+ 	allPeople _ allPeople copyWithout: currentItem.
+ 	self currentItem: nil.
+ 	self updatePeopleList.
+ !

Item was added:
+ ----- Method: PDA>>removeToDoItem (in category 'to do') -----
+ removeToDoItem
+ 
+ 	(self confirm: 'Rather than remove an item, it is
+ better to declare it done with a reason such as
+ ''gave up'', or ''not worth it'', to keep the record.
+ Do you still wish to remove it?')
+ 		ifFalse: [^ self].
+ 	allToDoItems _ allToDoItems copyWithout: currentItem.
+ 	self currentItem: nil.
+ 	self updateToDoList.
+ !

Item was added:
+ ----- Method: PDA>>sampleCategoryList (in category 'example') -----
+ sampleCategoryList
+ 
+ 	^ { 'home'. 'work'. 'services' }!

Item was added:
+ ----- Method: PDA>>sampleNotes (in category 'example') -----
+ sampleNotes
+ 
+ 	^ {
+ 	PDARecord new key: 'home'; description: 'sprinkler schedule'.
+ 	PDARecord new key: 'home'; description: 'directions to our house
+ Take the expressway, #93 south
+ Then south on Rte 24
+ East at the T with 195
+ Take exit 12 and go right to Faunce Corner
+ Cross rte 6, continue on Old Westport Rd
+ takes a bend left and becomes Chase Rd
+ Continue for 3.5-4 mi
+ Rt at T intersection on Russell Mills Rd
+ Pass DPW on left
+ Lg Yellow bldg Davall''s store
+ left on Rocko Dundee Rd
+ down a swail and up.  We''re #419 on the left'.
+ 	PDARecord new key: 'work'; description: 'archaeology memo'.
+ 	PDARecord new key: 'work'; description: 'worlds and envts memo'.
+ 	PDARecord new key: 'work'; description: PDA comment asString.
+ 	}!

Item was added:
+ ----- Method: PDA>>samplePeopleList (in category 'example') -----
+ samplePeopleList
+ 
+ 	^ {
+ 	PDAPerson new key: 'work'; name: 'Carson, Kit (&Lilly)'; phone: '888-555-1234'; email: 'Kit.Carson at Cosmo.com'.
+ 	PDAPerson new key: 'work'; name: 'Kidd, William (Billy)'; phone: '888-555-1234'; email: 'William.Kidd at Cosmo.com'.
+ 	PDAPerson new key: 'services'; name: 'Dewey, Cheatham & Howe'; phone: '888-555-1234'; email: 'AndHow at Cosmo.com'.
+ 	PDAPerson new key: 'home'; name: 'Duck, Donald'; phone: '888-555-1234'; email: 'Donald.Duck at Cosmo.com'.
+ 	PDAPerson new key: 'home'; name: 'Duck, Huey'; phone: '888-555-1234'; email: 'Huey.Duck at Cosmo.com'.
+ 	PDAPerson new key: 'home'; name: 'Duck, Dewey'; phone: '888-555-1234'; email: 'Dewey.Duck at Cosmo.com'.
+ 	PDAPerson new key: 'home'; name: 'Duck, Louie'; phone: '888-555-1234'; email: 'Louie.Duck at Cosmo.com'.
+ 	}!

Item was added:
+ ----- Method: PDA>>sampleRecurringEventsList (in category 'example') -----
+ sampleRecurringEventsList
+ 
+ 	^ {
+ 	PDARecurringEvent new key: 'home'; description: 'take out trash'; recurrence: #dayOfWeek; firstDate: (Date readFromString: '7 September 1999').
+ 	PDARecurringEvent new key: 'home'; description: 'pay bills'; recurrence: #dayOfMonth; firstDate: (Date readFromString: '1 September 1999').
+ 	PDARecurringEvent new key: 'all'; description: 'Columbus Day'; recurrence: #dateOfYear; firstDate: (Date readFromString: '12 October 1999').
+ 	PDARecurringEvent new key: 'all'; description: 'Christmas'; recurrence: #dateOfYear; firstDate: (Date readFromString: '25 December 1999').
+ 	PDARecurringEvent new key: 'all'; description: 'New Years'; recurrence: #dateOfYear; firstDate: (Date readFromString: '1 January 1999').
+ 	PDARecurringEvent new key: 'all'; description: 'April Fools Day'; recurrence: #dateOfYear; firstDate: (Date readFromString: '1 April 1999').
+ 	PDARecurringEvent new key: 'all'; description: 'Independence Day'; recurrence: #dateOfYear; firstDate: (Date readFromString: '4 July 1999').
+ 	PDARecurringEvent new key: 'all'; description: 'Thanksgiving Day'; recurrence: #nthWeekdayOfMonthEachYear; firstDate: (Date readFromString: '25 November 1999').
+ 	}!

Item was added:
+ ----- Method: PDA>>sampleScheduleList (in category 'example') -----
+ sampleScheduleList
+ 
+ 	^ {
+ 	PDAEvent new key: 'home'; date: Date today; description: 'wake up'; time: (Time hour: 6 minute: 0 second: 0).
+ 	PDAEvent new key: 'home'; date: Date today; description: 'go for a run'; time: (Time hour: 7 minute: 0 second: 0).
+ 	PDAEvent new key: 'home'; date: Date today; description: 'take a shower'; time: (Time hour: 8 minute: 0 second: 0).
+ 	PDAEvent new key: 'home'; date: (Date today addDays: 2); description: 'dinner out'; time: (Time hour: 18 minute: 0 second: 0).
+ 	PDAEvent new key: 'work'; date: (Date today addDays: 1); description: 'conf call'; time: (Time hour: 10 minute: 0 second: 0).
+ 	PDAEvent new key: 'work'; date: (Date today addDays: 2); description: 'Leave for Conference'; time: (Time hour: 8 minute: 0 second: 0).
+ 	PDAEvent new key: 'work'; date: Date today; description: 'call Boss'; time: (Time hour: 15 minute: 0 second: 0).
+ 	PDAEvent new key: 'work'; date: Date today; description: 'Call about 401k'; time: (Time hour: 10 minute: 0 second: 0).
+ 	}!

Item was added:
+ ----- Method: PDA>>sampleToDoList (in category 'example') -----
+ sampleToDoList
+ 
+ 	^ {
+ 	PDAToDoItem new key: 'work'; dayPosted: (Date today subtractDays: 3); description: 'release external updates'; priority: 2.
+ 	PDAToDoItem new key: 'work'; dayPosted: (Date today subtractDays: 3); description: 'first pass of sMovie'; priority: 1.
+ 	PDAToDoItem new key: 'work'; dayPosted: (Date today subtractDays: 2); description: 'first pass of PDA'; priority: 2.
+ 	PDAToDoItem new key: 'work'; dayPosted: (Date today subtractDays: 2); description: 'changes for finite undo'; priority: 2.
+ 	PDAToDoItem new key: 'work'; dayPosted: (Date today subtractDays: 1); description: 'Msg to Freeman Zork'; priority: 1.
+ 	PDAToDoItem new key: 'home'; dayPosted: (Date today subtractDays: 1); description: 'Fix fridge'; priority: 1.
+ 	PDAToDoItem new key: 'home'; dayPosted: (Date today subtractDays: 3); description: 'Fix roof'; priority: 3.
+ 	PDAToDoItem new key: 'home'; dayPosted: (Date today subtractDays: 3); description: 'Call about driveway'; priority: 4.
+ 	}!

Item was added:
+ ----- Method: PDA>>saveDatabase (in category 'initialization') -----
+ saveDatabase
+ 
+ 	(FileStream newFileNamed: (FileDirectory default nextNameFor: 'PDA' extension: 'pda'))
+ 		fileOutClass: nil
+ 		andObject: {userCategories. allPeople. allEvents. recurringEvents. allToDoItems. allNotes}.!

Item was added:
+ ----- Method: PDA>>scheduleList (in category 'schedule') -----
+ scheduleList
+ 	"Return the value of scheduleList"
+ 	^ scheduleList!

Item was added:
+ ----- Method: PDA>>scheduleListForDay: (in category 'schedule') -----
+ scheduleListForDay: aDate
+ 
+ 	| dayList |
+ 	dayList _ ((allEvents select: [:c | c matchesKey: 'all' andMatchesDate: aDate])
+ 			, ((recurringEvents select: [:c | c matchesKey: 'all' andMatchesDate: aDate])
+ 					collect: [:re | (re as: PDAEvent) date: aDate])) sort.
+ 	^ dayList collect: [:evt | evt asListItem]!

Item was added:
+ ----- Method: PDA>>scheduleListIndex (in category 'schedule') -----
+ scheduleListIndex
+ 	"Return the value of scheduleListIndex"
+ 	^ scheduleListIndex!

Item was added:
+ ----- Method: PDA>>scheduleListIndex: (in category 'schedule') -----
+ scheduleListIndex: newValue
+ 	"Assign newValue to scheduleListIndex."
+ 
+ 	scheduleListIndex = newValue ifTrue: [^ self].
+ 	self okToChange ifFalse: [^ self].
+ 	scheduleListIndex _ newValue.
+ 	self currentItem: (scheduleListIndex ~= 0
+ 						ifTrue: [scheduleList at: scheduleListIndex]
+ 						ifFalse: [nil]).
+ 	self changed: #scheduleListIndex.!

Item was added:
+ ----- Method: PDA>>scheduleListItems (in category 'schedule') -----
+ scheduleListItems
+ 
+ 	^ scheduleList collect: [:p | p asListItem]!

Item was added:
+ ----- Method: PDA>>scheduleMenu: (in category 'schedule') -----
+ scheduleMenu: aMenu
+ 
+ 	date ifNil: [^ aMenu add: 'select a date' target: self selector: #yourself.].
+ 	self categorySelected ~= 'recurring' ifTrue:
+ 		[aMenu add: 'add new event' target: self selector: #addEvent].
+ 	aMenu add: 'add recurring event' target: self selector: #addRecurringEvent.
+ 	scheduleListIndex > 0 ifTrue:
+ 		[(currentItem isKindOf: PDARecurringEvent) ifTrue:
+ 			[aMenu add: 'declare last date' target: self selector: #declareLastDate].
+ 		aMenu add: 'remove event' target: self selector: #removeEvent].
+ 	^ aMenu!

Item was added:
+ ----- Method: PDA>>selectCategory: (in category 'category') -----
+ selectCategory: cat
+ 
+ 	category _ cat.
+ 	self updateScheduleList.
+ 	self updateToDoList.
+ 	self updatePeopleList.
+ 	self updateNotesList.
+ 	currentItem ifNil: [^ self].
+ 	(scheduleListIndex + toDoListIndex + peopleListIndex + notesListIndex) = 0 ifTrue:
+ 		["Old current item is no longer current (not in any list)"
+ 		currentItem _ nil.
+ 		self changed: #currentItemText]!

Item was added:
+ ----- Method: PDA>>selectDate: (in category 'date') -----
+ selectDate: aDate
+ 
+ 	date _ aDate.
+ 	self updateScheduleList.
+ 	self updateToDoList.
+ 	self updateCurrentItem.!

Item was added:
+ ----- Method: PDA>>setDate:fromButton:down: (in category 'date') -----
+ setDate: aDate fromButton: aButton down: down 
+ 	dateButtonPressed ifNotNil: [dateButtonPressed setSwitchState: false].
+ 	dateButtonPressed := down 
+ 				ifTrue:  
+ 					[self selectDate: aDate.
+ 					aButton]
+ 				ifFalse: 
+ 					[self selectDate: nil.
+ 					nil].
+ 	self currentItem: nil.
+ 	aButton ifNotNil: 
+ 			[aButton owner owner highlightToday	"ugly hack to restore highlight for today"]!

Item was added:
+ ----- Method: PDA>>toDoList (in category 'to do') -----
+ toDoList
+ 	"Return the value of toDoList"
+ 	^ toDoList!

Item was added:
+ ----- Method: PDA>>toDoListIndex (in category 'to do') -----
+ toDoListIndex
+ 	"Return the value of toDoListIndex"
+ 	^ toDoListIndex!

Item was added:
+ ----- Method: PDA>>toDoListIndex: (in category 'to do') -----
+ toDoListIndex: newValue
+ 	"Assign newValue to toDoListIndex."
+ 
+ 	toDoListIndex = newValue ifTrue: [^ self].
+ 	self okToChange ifFalse: [^ self].
+ 	toDoListIndex _ newValue.
+ 	self currentItem: (toDoListIndex ~= 0
+ 						ifTrue: [toDoList at: toDoListIndex]
+ 						ifFalse: [nil]).
+ 	self changed: #toDoListIndex.!

Item was added:
+ ----- Method: PDA>>toDoListItems (in category 'to do') -----
+ toDoListItems
+ 
+ 	^ toDoList collect: [:p | p asListItem]!

Item was added:
+ ----- Method: PDA>>toDoMenu: (in category 'to do') -----
+ toDoMenu: aMenu
+ 
+ 	date ifNil: [^ aMenu add: 'select a date' target: self selector: #yourself.].
+ 	aMenu add: 'add new item' target: self selector: #addToDoItem.
+ 	toDoListIndex > 0 ifTrue:
+ 		[aMenu add: 'declare item done' target: self selector: #declareItemDone.
+ 		aMenu add: 'remove item' target: self selector: #removeToDoItem].
+ 	^ aMenu!

Item was added:
+ ----- Method: PDA>>toggleDescriptionMode (in category 'currentItem') -----
+ toggleDescriptionMode
+ 
+ 	self okToChange ifFalse: [^ self].
+ 	viewDescriptionOnly _ viewDescriptionOnly not.
+ 	self changed: #currentItemText!

Item was added:
+ ----- Method: PDA>>updateCurrentItem (in category 'currentItem') -----
+ updateCurrentItem
+ 
+ 	(peopleList includes: currentItem) ifTrue: [^ self].
+ 	(scheduleList includes: currentItem) ifTrue: [^ self].
+ 	(toDoList includes: currentItem) ifTrue: [^ self].
+ 	(notesList includes: currentItem) ifTrue: [^ self].
+ 	self currentItem: nil!

Item was added:
+ ----- Method: PDA>>updateNotesList (in category 'notes') -----
+ updateNotesList
+ 
+ 	notesList _ (allNotes select: [:c | c matchesKey: self categorySelected]) sort.
+ 	self notesListIndex: (notesList indexOf: currentItem).
+ 	self changed: #notesListItems!

Item was added:
+ ----- Method: PDA>>updatePeopleList (in category 'people') -----
+ updatePeopleList
+ 
+ 	peopleList _ (allPeople select: [:c | c matchesKey: category]) sort.
+ 	peopleListIndex _ peopleList indexOf: currentItem.
+ 	self changed: #peopleListItems!

Item was added:
+ ----- Method: PDA>>updateScheduleList (in category 'schedule') -----
+ updateScheduleList
+ 	(date isNil
+ 			and: [category ~= 'recurring'])
+ 		ifTrue: [scheduleList _ Array new.
+ 			scheduleListIndex _ 0.
+ 			^ self changed: #scheduleListItems].
+ 	scheduleList _ (category = 'recurring'
+ 				ifTrue: ["When 'recurring' is selected, edit actual masters"
+ 					(recurringEvents
+ 						select: [:c | c matchesKey: category andMatchesDate: date]) ]
+ 				ifFalse: ["Otherwise, recurring events just spawn copies."
+ 					((allEvents
+ 						select: [:c | c matchesKey: category andMatchesDate: date])
+ 						, ((recurringEvents
+ 								select: [:c | c matchesKey: category andMatchesDate: date])
+ 								collect: [:re | (re as: PDAEvent)
+ 										date: date])) ])sort.
+ 	scheduleListIndex _ scheduleList indexOf: currentItem.
+ 	self changed: #scheduleListItems!

Item was added:
+ ----- Method: PDA>>updateToDoList (in category 'to do') -----
+ updateToDoList
+ 
+ 	date ifNil:
+ 		[toDoList _ Array new. toDoListIndex _ 0.
+ 		^ self changed: #toDoListItems].
+ 	toDoList _ (allToDoItems select: [:c | c matchesKey: category andMatchesDate: date]) sort.
+ 	toDoListIndex _ toDoList indexOf: currentItem.
+ 	self changed: #toDoListItems!

Item was added:
+ ----- Method: PDA>>userCategories:allPeople:allEvents:recurringEvents:allToDoItems:allNotes:dateSelected: (in category 'initialization') -----
+ userCategories: cats allPeople: ppl allEvents: evts recurringEvents: recEvts allToDoItems: todo allNotes: notes dateSelected: aDate
+ 
+ 	userCategories _ cats.
+ 	allPeople _ ppl.
+ 	allEvents _ evts.
+ 	recurringEvents _ recEvts.
+ 	allToDoItems _ todo.
+ 	allNotes _ notes.
+ 	
+ 	date _ aDate.  "Because updates ahead will need *both* date and category"
+ 	self selectCategory: 'all'.
+ 	self selectDate: aDate.  "Superfluous, but might not be"!

Item was added:
+ PopUpChoiceMorph subclass: #PDAChoiceMorph
+ 	instanceVariableNames: 'backgroundColor'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-PDA'!
+ 
+ !PDAChoiceMorph commentStamp: '<historical>' prior: 0!
+ See PDA comment. !

Item was added:
+ ----- Method: PDAChoiceMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 
+ 	^ false!

Item was added:
+ ----- Method: PDAChoiceMorph>>color (in category 'accessing') -----
+ color
+ 
+ 	^ backgroundColor!

Item was added:
+ ----- Method: PDAChoiceMorph>>color: (in category 'accessing') -----
+ color: aColor
+ 
+ 	backgroundColor _ aColor.
+ 	self changed!

Item was added:
+ ----- Method: PDAChoiceMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 
+ 	| offset |
+ 	offset _ 4@(bounds height - self fontToUse height // 2).
+ 	aCanvas frameAndFillRectangle: bounds fillColor: backgroundColor
+ 			borderWidth: 1 borderColor: Color black.
+ 	aCanvas drawString: contents
+ 			in: ((bounds translateBy: offset) intersect: bounds)
+ 			font: self fontToUse color: Color black.
+ !

Item was added:
+ WatchMorph subclass: #PDAClockMorph
+ 	instanceVariableNames: 'backgroundColor'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-PDA'!
+ 
+ !PDAClockMorph commentStamp: '<historical>' prior: 0!
+ See PDA comment. '!

Item was added:
+ ----- Method: PDAClockMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 
+ 	^ false!

Item was added:
+ ----- Method: PDAClockMorph>>color (in category 'accessing') -----
+ color
+ 	^ backgroundColor!

Item was added:
+ ----- Method: PDAClockMorph>>color: (in category 'accessing') -----
+ color: aColor
+ 	backgroundColor _ aColor.
+ 	self changed!

Item was added:
+ ----- Method: PDAClockMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 
+ 	aCanvas frameAndFillRectangle: bounds fillColor: backgroundColor
+ 				borderWidth: 1 borderColor: borderColor.
+ 	super drawOn: aCanvas.
+ !

Item was added:
+ ----- Method: PDAClockMorph>>faceColor: (in category 'as yet unclassified') -----
+ faceColor: aColor
+ 	super color: aColor!

Item was added:
+ PDARecord subclass: #PDAEvent
+ 	instanceVariableNames: 'date time duration alarm'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-PDA'!
+ 
+ !PDAEvent commentStamp: '<historical>' prior: 0!
+ See PDA comment. !

Item was added:
+ ----- Method: PDAEvent>><= (in category 'comparing') -----
+ <= other 
+ 	date = other date ifFalse: [^date < other date].
+ 	time isNil ifTrue: [^true].
+ 	other time isNil ifTrue: [^false].
+ 	^time <= other time!

Item was added:
+ ----- Method: PDAEvent>>asListItem (in category 'as text') -----
+ asListItem
+ 
+ 	| timeString ampm |
+ 	time ifNil: [^ '-- ' , (description copyUpTo: Character cr) , ' --'].
+ 	timeString _ time printString.
+ 	ampm _ timeString last: 2.
+ 	^ (timeString allButLast: 3) , ampm , '  ' , (description copyUpTo: Character cr)!

Item was added:
+ ----- Method: PDAEvent>>date (in category 'date') -----
+ date
+ 	"Return the value of date"
+ 	^ date!

Item was added:
+ ----- Method: PDAEvent>>date: (in category 'date') -----
+ date: newValue
+ 	"Assign newValue to date."
+ 
+ 	date _ newValue.!

Item was added:
+ ----- Method: PDAEvent>>duration (in category 'duration') -----
+ duration
+ 	"Return the value of duration"
+ 	^ duration!

Item was added:
+ ----- Method: PDAEvent>>duration: (in category 'duration') -----
+ duration: newValue
+ 	"Assign newValue to duration."
+ 
+ 	duration _ newValue.!

Item was added:
+ ----- Method: PDAEvent>>matchesDate: (in category 'date') -----
+ matchesDate: aDate
+ 
+ 	^ date = aDate!

Item was added:
+ ----- Method: PDAEvent>>time (in category 'time') -----
+ time
+ 	"Return the value of time"
+ 	^ time!

Item was added:
+ ----- Method: PDAEvent>>time: (in category 'time') -----
+ time: newValue
+ 	"Assign newValue to time."
+ 
+ 	time _ newValue!

Item was added:
+ SystemWindow subclass: #PDAMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-PDA'!
+ 
+ !PDAMorph commentStamp: '<historical>' prior: 0!
+ See PDA comment. !

Item was added:
+ ----- Method: PDAMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName:	'PDA' translatedNoop
+ 		categories:		#()
+ 		documentation:	'A Personal Digital Assistant' translatedNoop!

Item was added:
+ ----- Method: PDAMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color lightGray!

Item was added:
+ ----- Method: PDAMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	
+ 	self extent: 406 @ 408.
+ 	PDA new initialize openAsMorphIn: self!

Item was added:
+ ----- Method: PDAMorph>>initializeToStandAlone (in category 'parts bin') -----
+ initializeToStandAlone
+ 	super initializeToStandAlone.
+ 	self fullBounds  "seemingly necessary to get its icon right in a parts bin"!

Item was added:
+ ----- Method: PDAMorph>>step (in category 'stepping and presenter') -----
+ step
+ 
+ 	self setLabel: model labelString.  "Super won't step if collapsed"
+ 	super step.
+ 	!

Item was added:
+ ----- Method: PDAMorph>>stepTime (in category 'testing') -----
+ stepTime
+ 
+ 	^ (60 - Time now seconds + 1) * 1000
+ !

Item was added:
+ ----- Method: PDAMorph>>wantsSteps (in category 'testing') -----
+ wantsSteps
+ 
+ 	^ true  "collapsed or not"!

Item was added:
+ ----- Method: PDAMorph>>wantsStepsWhenCollapsed (in category 'stepping') -----
+ wantsStepsWhenCollapsed
+ 	"Keep time up to date in title bar"
+ 
+ 	^ true!

Item was added:
+ PDARecord subclass: #PDAPerson
+ 	instanceVariableNames: 'name address phone email'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-PDA'!
+ 
+ !PDAPerson commentStamp: '<historical>' prior: 0!
+ See PDA comment. !

Item was added:
+ ----- Method: PDAPerson>><= (in category 'comparing') -----
+ <= other
+ 
+ 	^ name <= other name!

Item was added:
+ ----- Method: PDAPerson>>address (in category 'public access') -----
+ address
+ 	"Return the value of address"
+ 	^ address!

Item was added:
+ ----- Method: PDAPerson>>address: (in category 'public access') -----
+ address: newValue
+ 	"Assign newValue to address."
+ 
+ 	address _ newValue.!

Item was added:
+ ----- Method: PDAPerson>>asListItem (in category 'as text') -----
+ asListItem
+ 
+ 	^ name!

Item was added:
+ ----- Method: PDAPerson>>email (in category 'public access') -----
+ email
+ 	"Return the value of email"
+ 	^ email!

Item was added:
+ ----- Method: PDAPerson>>email: (in category 'public access') -----
+ email: newValue
+ 	"Assign newValue to email."
+ 
+ 	email _ newValue.!

Item was added:
+ ----- Method: PDAPerson>>name (in category 'testing') -----
+ name
+ 	"Return the value of name"
+ 	^ name!

Item was added:
+ ----- Method: PDAPerson>>name: (in category 'public access') -----
+ name: newValue
+ 	"Assign newValue to name."
+ 
+ 	name _ newValue.!

Item was added:
+ ----- Method: PDAPerson>>phone (in category 'public access') -----
+ phone
+ 	"Return the value of phone"
+ 	^ phone!

Item was added:
+ ----- Method: PDAPerson>>phone: (in category 'public access') -----
+ phone: newValue
+ 	"Assign newValue to phone."
+ 
+ 	phone _ newValue.!

Item was added:
+ Object subclass: #PDARecord
+ 	instanceVariableNames: 'key description otherFields'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-PDA'!
+ 
+ !PDARecord commentStamp: '<historical>' prior: 0!
+ See PDA comment. !

Item was added:
+ ----- Method: PDARecord>><= (in category 'comparing') -----
+ <= other
+ 
+ 	^ (description compare: other description) <= 2  "Case-insensitive"!

Item was added:
+ ----- Method: PDARecord>>allFieldsWithValuesDo: (in category 'as text') -----
+ allFieldsWithValuesDo: nameValueBlock
+ 
+ 	self sharedFieldsWithValuesDo: nameValueBlock.
+ 	otherFields ifNotNil:
+ 		[otherFields associationsDo:
+ 			[:assn | nameValueBlock value: assn key value: assn value]]!

Item was added:
+ ----- Method: PDARecord>>asListItem (in category 'as text') -----
+ asListItem
+ 
+ 	^ description copyUpTo: Character cr!

Item was added:
+ ----- Method: PDARecord>>asText (in category 'as text') -----
+ asText
+ 
+ 	^ String streamContents:
+ 		[:s | self allFieldsWithValuesDo:
+ 			[:field :value | s nextPutAll: field; nextPutAll: ': '; store: value; cr]]!

Item was added:
+ ----- Method: PDARecord>>description (in category 'description') -----
+ description
+ 	"Return the value of description"
+ 	^ description!

Item was added:
+ ----- Method: PDARecord>>description: (in category 'description') -----
+ description: newValue
+ 	"Assign newValue to description."
+ 
+ 	description _ newValue.!

Item was added:
+ ----- Method: PDARecord>>key (in category 'key') -----
+ key
+ 	"Return the value of key"
+ 	^ key!

Item was added:
+ ----- Method: PDARecord>>key: (in category 'key') -----
+ key: newValue
+ 	"Assign newValue to key."
+ 
+ 	key _ newValue.!

Item was added:
+ ----- Method: PDARecord>>matchesKey: (in category 'key') -----
+ matchesKey: aString
+ 
+ 	key ifNil: [^ true].  "unkeyed items show up as 'all' "
+ 	(aString = 'all' or: [key = 'all']) ifTrue: [^ true].
+ 	^ key = aString!

Item was added:
+ ----- Method: PDARecord>>matchesKey:andMatchesDate: (in category 'key') -----
+ matchesKey: aString andMatchesDate: aDate
+ 	"May be overridden for efficiency"
+ 	^ (self matchesKey: aString) and: [self matchesDate: aDate]!

Item was added:
+ ----- Method: PDARecord>>otherFields (in category 'other fields') -----
+ otherFields
+ 	"Return the value of otherFields"
+ 	^ otherFields!

Item was added:
+ ----- Method: PDARecord>>otherFields: (in category 'other fields') -----
+ otherFields: newValue
+ 	"Assign newValue to otherFields."
+ 
+ 	otherFields _ newValue.!

Item was added:
+ ----- Method: PDARecord>>printOn: (in category 'printing') -----
+ printOn: aStream
+ 
+ 	super printOn: aStream.
+ 	aStream space; nextPutAll: self asListItem!

Item was added:
+ ----- Method: PDARecord>>readField:fromString:fields:base: (in category 'as text') -----
+ readField: fieldName fromString: aString fields: sharedFields base: instVarBase
+ 	"This message should be overridden in subclasses to recognize the types for the various fields.  If a fieldName is not recognized below, super will invoke this method at the end."
+ 
+ 	(sharedFields includes: fieldName) ifTrue:
+ 		[^ self instVarAt: instVarBase + (sharedFields indexOf: fieldName)
+ 				put: (Compiler evaluate: aString)].
+ 
+ 	otherFields ifNil: [otherFields _ Dictionary new].
+ 	otherFields at: fieldName put: (Compiler evaluate: aString)
+ !

Item was added:
+ ----- Method: PDARecord>>readFrom: (in category 'as text') -----
+ readFrom: aText
+ 	| buffer tokenStream fieldName token |
+ 	tokenStream _ ReadStream on: (Scanner new scanTokens: aText asString).
+ 	buffer _ WriteStream on: (String new: 500).
+ 	fieldName _ nil.
+ 	self sharedFieldsWithBaseDo:
+ 		[:fields :instVarBase |  
+ 		[tokenStream atEnd] whileFalse:
+ 			[token _ tokenStream next.
+ 			((token isSymbol) and: [token endsWith: ':'])
+ 				ifTrue: [fieldName ifNotNil:
+ 							[self readField: fieldName fromString: buffer contents
+ 								fields: fields base: instVarBase].
+ 						buffer reset.  fieldName _ token allButLast]
+ 				ifFalse: [(token isSymbol)
+ 							ifTrue: [buffer nextPutAll: token; space]
+ 							ifFalse: [buffer print: token; space]]].
+ 		self readField: fieldName fromString: buffer contents
+ 			fields: fields base: instVarBase]!

Item was added:
+ ----- Method: PDARecord>>rekey:to: (in category 'key') -----
+ rekey: oldKey to: newKey
+ 
+ 	key = oldKey ifTrue: [key _ newKey]!

Item was added:
+ ----- Method: PDARecord>>sharedFieldsWithBaseDo: (in category 'as text') -----
+ sharedFieldsWithBaseDo: fieldsAndBaseBlock
+ 
+ 	| fields base |
+ 	fields _ self class allInstVarNames allButFirst: (base _ PDARecord superclass instSize).
+ 	fieldsAndBaseBlock value: fields value: base!

Item was added:
+ ----- Method: PDARecord>>sharedFieldsWithValuesDo: (in category 'as text') -----
+ sharedFieldsWithValuesDo: nameValueBlock
+ 
+ 	self sharedFieldsWithBaseDo:
+ 		[:fields :instVarBase |
+ 		fields withIndexDo:
+ 			[:field :i | field = 'otherFields' ifFalse:
+ 				[nameValueBlock value: field value: (self instVarAt: instVarBase + i)]]]!

Item was added:
+ PDAEvent subclass: #PDARecurringEvent
+ 	instanceVariableNames: 'recurrence firstDate lastDate'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-PDA'!
+ 
+ !PDARecurringEvent commentStamp: '<historical>' prior: 0!
+ See PDA comment. !

Item was added:
+ ----- Method: PDARecurringEvent class>>chooseRecurrence (in category 'as yet unclassified') -----
+ chooseRecurrence
+ 
+ 	^ (CustomMenu selections: self basicNew validRecurrenceSymbols) startUp
+ 		ifNil: [#dateOfYear]!

Item was added:
+ ----- Method: PDARecurringEvent>>firstDate: (in category 'as yet unclassified') -----
+ firstDate: aDate
+ 
+ 	firstDate _ aDate
+ !

Item was added:
+ ----- Method: PDARecurringEvent>>lastDate: (in category 'as yet unclassified') -----
+ lastDate: aDate
+ 
+ 	lastDate _ aDate
+ !

Item was added:
+ ----- Method: PDARecurringEvent>>matchesDate: (in category 'date') -----
+ matchesDate: aDate 
+ 	(firstDate isNil or: [firstDate > aDate]) ifTrue: [^false].
+ 	(lastDate notNil and: [lastDate < aDate]) ifTrue: [^false].
+ 	recurrence == #eachDay ifTrue: [^true].
+ 	recurrence == #dayOfWeek ifTrue: [^aDate weekday = firstDate weekday].
+ 	recurrence == #dayOfMonth 
+ 		ifTrue: [^aDate dayOfMonth = firstDate dayOfMonth].
+ 	recurrence == #dateOfYear 
+ 		ifTrue: 
+ 			[^aDate monthIndex = firstDate monthIndex 
+ 				and: [aDate dayOfMonth = firstDate dayOfMonth]].
+ 	recurrence == #nthWeekdayOfMonth 
+ 		ifTrue: 
+ 			[^aDate weekday = firstDate weekday 
+ 				and: [(aDate dayOfMonth - 1) // 7 = ((firstDate dayOfMonth - 1) // 7)]].
+ 	recurrence == #nthWeekdayOfMonthEachYear 
+ 		ifTrue: 
+ 			[^aDate monthIndex = firstDate monthIndex and: 
+ 					[aDate weekday = firstDate weekday 
+ 						and: [(aDate dayOfMonth - 1) // 7 = ((firstDate dayOfMonth - 1) // 7)]]]!

Item was added:
+ ----- Method: PDARecurringEvent>>matchesKey:andMatchesDate: (in category 'key') -----
+ matchesKey: aString andMatchesDate: aDate
+ 
+ 	aString = 'recurring' ifTrue: [^ true].
+ 	^ super matchesKey: aString andMatchesDate: aDate!

Item was added:
+ ----- Method: PDARecurringEvent>>readField:fromString:fields:base: (in category 'as text') -----
+ readField: fieldName fromString: aString fields: sharedFields base: instVarBase
+ 	"Overridden to check for valid recurrence symbol"
+ 
+ 	fieldName = 'recurrence' ifTrue: [^ self recurrence: aString withBlanksTrimmed asSymbol].
+ 	^ super readField: fieldName fromString: aString fields: sharedFields base: instVarBase
+ !

Item was added:
+ ----- Method: PDARecurringEvent>>recurrence (in category 'as yet unclassified') -----
+ recurrence
+ 	"Return the value of recurrence"
+ 	^ recurrence!

Item was added:
+ ----- Method: PDARecurringEvent>>recurrence: (in category 'as yet unclassified') -----
+ recurrence: rSymbol
+ 	(self validRecurrenceSymbols includes: rSymbol)
+ 		ifFalse: [^ self error: 'unrecognized recurrence symbol: , rSymbol'].
+ 	recurrence _ rSymbol!

Item was added:
+ ----- Method: PDARecurringEvent>>validRecurrenceSymbols (in category 'as yet unclassified') -----
+ validRecurrenceSymbols
+ 	^ #(eachDay dayOfWeek dayOfMonth dateOfYear nthWeekdayOfMonth nthWeekdayOfMonthEachYear)!

Item was added:
+ PDARecord subclass: #PDAToDoItem
+ 	instanceVariableNames: 'dayPosted dayDone priority deadline result'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-PDA'!
+ 
+ !PDAToDoItem commentStamp: '<historical>' prior: 0!
+ See PDA comment. !

Item was added:
+ ----- Method: PDAToDoItem>><= (in category 'comparing') -----
+ <= other
+ 
+ 	priority = other priority ifFalse: [^ priority < other priority].
+ 	^ super <= other!

Item was added:
+ ----- Method: PDAToDoItem>>asListItem (in category 'as text') -----
+ asListItem
+ 
+ 	^ (priority ifNil: [0]) printString , ' ' , super asListItem!

Item was added:
+ ----- Method: PDAToDoItem>>dayDone (in category 'day done') -----
+ dayDone
+ 	"Return the value of dayDone"
+ 	^ dayDone!

Item was added:
+ ----- Method: PDAToDoItem>>dayDone: (in category 'day done') -----
+ dayDone: newValue
+ 	"Assign newValue to dayDone."
+ 
+ 	dayDone _ newValue.!

Item was added:
+ ----- Method: PDAToDoItem>>dayPosted (in category 'day posted') -----
+ dayPosted
+ 	"Return the value of dayPosted"
+ 	^ dayPosted!

Item was added:
+ ----- Method: PDAToDoItem>>dayPosted: (in category 'day posted') -----
+ dayPosted: newValue
+ 	"Assign newValue to dayPosted."
+ 
+ 	dayPosted _ newValue.!

Item was added:
+ ----- Method: PDAToDoItem>>deadline (in category 'deadline') -----
+ deadline
+ 	"Return the value of deadline"
+ 	^ deadline!

Item was added:
+ ----- Method: PDAToDoItem>>deadline: (in category 'deadline') -----
+ deadline: newValue
+ 	"Assign newValue to deadline."
+ 
+ 	deadline _ newValue.!

Item was added:
+ ----- Method: PDAToDoItem>>matchesDate: (in category 'day posted') -----
+ matchesDate: aDate
+ 
+ 	dayPosted > aDate ifTrue: [^ false].
+ 	dayDone ifNil: [^ true].
+ 	^ dayDone >= aDate!

Item was added:
+ ----- Method: PDAToDoItem>>priority (in category 'priority') -----
+ priority
+ 	"Return the value of priority"
+ 	^ priority!

Item was added:
+ ----- Method: PDAToDoItem>>priority: (in category 'priority') -----
+ priority: newValue
+ 	"Assign newValue to priority."
+ 
+ 	priority _ newValue.!

Item was added:
+ ----- Method: PDAToDoItem>>result (in category 'result') -----
+ result
+ 	"Return the value of result"
+ 	^ result!

Item was added:
+ ----- Method: PDAToDoItem>>result: (in category 'result') -----
+ result: newValue
+ 	"Assign newValue to result."
+ 
+ 	result _ newValue.!

Item was added:
+ ----- Method: PaintBoxMorph class>>replace4ButtonsWithDict: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ replace4ButtonsWithDict: aDictionary
+ 
+ 	self prototype replace4ButtonsWith: aDictionary.
+ !

Item was added:
+ ----- Method: PaintBoxMorph class>>smallestNibSizeChanged (in category '*Etoys-Squeakland-instance creation') -----
+ smallestNibSizeChanged
+ 	"The user changed the size of the smallest nib in the paint box.  Change the prototype(s) to reflect this change."
+ 
+ 	| aWidth aButton |
+ 	aWidth := Preferences singlePixelNib ifTrue: [1] ifFalse:[3].
+ 	self allInstancesDo:
+ 		[:aPaintBox |
+ 			aButton :=  aPaintBox submorphNamed: #brush1:.
+ 			aButton arguments at: 3
+ 				put: (Form dotOfSize:  aWidth).
+ 			aButton doButtonAction]!

Item was added:
+ ----- Method: PaintBoxMorph>>beSupersized (in category '*Etoys-Squeakland-initialization') -----
+ beSupersized
+ 	| scaleFactor |
+ 	scaleFactor := 1.5.
+ 	self isFlexed
+ 		ifFalse: [self scaleFactor: scaleFactor.
+ 			self position: self position / scaleFactor.
+ 			self changed]!

Item was added:
+ ----- Method: PaintBoxMorph>>brush: (in category '*Etoys-Squeakland-actions') -----
+ brush: aSymbol 
+ 	"aSymbol is like #brush:"
+ 	| newBrush |
+ 	newBrush := brushes
+ 				detect: [:each | each arguments second == aSymbol].
+ 	currentBrush
+ 		ifNotNil: [currentBrush state: #off].
+ 	newBrush state: #on.
+ 	currentBrush := newBrush.
+ !

Item was added:
+ ----- Method: PaintBoxMorph>>currentBrushSymbol (in category '*Etoys-Squeakland-initialization') -----
+ currentBrushSymbol
+ 	"Answer the symbol associated with the current brush."
+ 
+ 	
+ 	^ currentBrush arguments second
+ 
+ "
+ PaintBoxMorph prototype currentBrushSymbol
+ "!

Item was added:
+ ----- Method: PaintBoxMorph>>currentColor: (in category '*Etoys-Squeakland-actions') -----
+ currentColor: aColor
+ 	currentColor := aColor!

Item was added:
+ ----- Method: PaintBoxMorph>>initializeBrush (in category '*Etoys-Squeakland-initialization') -----
+ initializeBrush
+ 	| brushMap |
+ 	"PaintBoxMorph initialize"
+ 	currentColor := Color blue.
+ 	self brush: #brush3:.
+ 	brushMap := Dictionary new.
+ 	brushMap at: #brush1: put: 3.
+ 	brushMap at: #brush2: put: 7.
+ 	brushMap at: #brush3: put: 13.
+ 	brushMap at: #brush4: put: 26.
+ 	brushMap at: #brush5: put: 50.
+ 	brushMap at: #brush6: put: 80.
+ 	brushMap
+ 		keysAndValuesDo: [:key :value | (self submorphNamed: key) arguments
+ 				at: 3
+ 				put: (Form dotOfSize: value)]!

Item was added:
+ ----- Method: PaintBoxMorph>>replace4ButtonsWith: (in category '*Etoys-Squeakland-replace artwork') -----
+ replace4ButtonsWith: formDict
+ 
+ 	| pos m |
+ 	#('undo' 'keep' 'clear' 'toss') do: [:b |
+ 		pos _ (m _ submorphs detect: [:n | n externalName beginsWith: b]) position - self position.
+ 		(formDict at: (b, 'On.png')) displayOn: image at: pos.
+ 		m pressedImage: (formDict at: (b, 'Pressed.png')).
+ 	].
+ !

Item was added:
+ ----- Method: PaintBoxMorph>>replace6ButtonsWith: (in category '*Etoys-Squeakland-replace artwork') -----
+ replace6ButtonsWith: formDict
+ 
+ 	| m |
+ 	1 to: 6 do: [:b |
+ 		m _ submorphs detect: [:n | n externalName beginsWith: 'brush', b printString].
+ 		m onImage: (formDict at: ('brush', b printString, 'On.png')).
+ 		m offImage: (formDict at: ('brush', b printString, 'Off.png')).
+ 		m pressedImage: (formDict at: ('brush', b printString, 'On.png')).
+ 		(formDict at: ('brush', b printString, 'Off.png')) displayOn: image at: (m position - self position).
+ 	].
+ 	brushes _ OrderedCollection new.
+ 	#(#brush1: #brush2: #brush3: #brush4: #brush5: #brush6:) 
+ 		do: [:sel | brushes addLast: (self submorphNamed: sel)].
+ !

Item was added:
+ ----- Method: PaintBoxMorph>>saveStampsAndColors (in category '*Etoys-Squeakland-initialization') -----
+ saveStampsAndColors
+ 	"Stuff them into the prototype"
+ 
+ 	Prototype stampHolder stamps: stampHolder stamps.
+ 	Prototype stampHolder thumbnailPics: stampHolder thumbnailPics.!

Item was added:
+ ----- Method: ParagraphEditor>>indent:fromStream:toStream: (in category '*Etoys-Squeakland-private') -----
+ indent: delta fromStream: inStream toStream: outStream
+ 	"Append the contents of inStream to outStream, adding or deleting delta or -delta
+ 	 tabs at the beginning, and after every CR except a final CR.  Do not add tabs
+ 	 to totally empty lines, and be sure nothing but tabs are removed from lines."
+ 
+ 	| ch skip cr tab prev atEnd |
+ 	cr _ Character cr.
+ 	tab _ Character tab.
+ 	delta > 0
+ 		ifTrue: "shift right"
+ 			[prev _ cr.
+ 			 [ch _ (atEnd _ inStream atEnd) ifTrue: [cr] ifFalse: [inStream next].
+ 			  (prev == cr and: [ch ~~ cr]) ifTrue:
+ 				[delta timesRepeat: [outStream nextPut: tab]].
+ 			  atEnd]
+ 				whileFalse:
+ 					[outStream nextPut: ch.
+ 					prev _ ch]]
+ 		ifFalse: "shift left"
+ 			[skip _ delta. "a negative number"
+ 			 [inStream atEnd] whileFalse:
+ 				[((ch _ inStream next) == tab and: [skip < 0]) ifFalse:
+ 					[outStream nextPut: ch].
+ 				skip _ ch == cr ifTrue: [delta] ifFalse: [skip + 1]]]!

Item was added:
+ ----- Method: ParagraphEditor>>recognizeCharacters (in category '*Etoys-Squeakland-typing support') -----
+ recognizeCharacters
+ 	"Recognize hand-written characters and put them into the receiving pane.  Invokes Alan's character recognizer.  2/5/96 sw"
+ 
+ 	self recognizeCharactersWhileMouseIn: view insetDisplayBox!

Item was added:
+ ----- Method: ParagraphEditor>>recognizeCharactersWhileMouseIn: (in category '*Etoys-Squeakland-typing support') -----
+ recognizeCharactersWhileMouseIn: box
+ 	"Recognize hand-written characters and put them into the receiving pane.  Invokes Alan's character recognizer.  2/5/96 sw"
+ 
+ 	| aRecognizer |
+ 	Cursor marker showWhile:
+ 		[aRecognizer _ CharRecog new.
+ 		aRecognizer recognizeAndDispatch:
+ 			[:char | char == BS
+ 				ifTrue:
+ 					[self simulatedBackspace]
+ 				ifFalse:
+ 					[self simulatedKeystroke: char]]
+ 		until:
+ 			[(box containsPoint: sensor cursorPoint) not]].
+ 	view display!

Item was added:
+ ----- Method: ParagraphEditor>>recognizer: (in category '*Etoys-Squeakland-editing keys') -----
+ recognizer: characterStream 
+ 	"Invoke Alan's character recognizer from cmd-r 2/2/96 sw"
+ 
+ 	sensor keyboard.
+ 	self recognizeCharacters.
+ 	^ true!

Item was added:
+ ----- Method: ParagraphEditor>>shiftEnclose: (in category '*Etoys-Squeakland-editing keys') -----
+ shiftEnclose: characterStream
+ 	"Insert or remove bracket characters around the current selection.
+ 	 Flushes typeahead."
+ 
+ 	| char left right startIndex stopIndex oldSelection which text |
+ 	char _ sensor keyboard.
+ 	char = $9 ifTrue: [ char _ $( ].
+ 	char = $, ifTrue:     "[ char _ $< ]"
+ 		[self closeTypeIn.
+ 		ActiveWorld showSourceKeyHit.
+ 		^ true].
+ 	char = $[ ifTrue: [ char _ ${ ].
+ 	char = $' ifTrue: [ char _ $" ].
+ 	char asciiValue = 27 ifTrue: [ char _ ${ ].	"ctrl-["
+ 
+ 	self closeTypeIn.
+ 	startIndex _ self startIndex.
+ 	stopIndex _ self stopIndex.
+ 	oldSelection _ self selection.
+ 	which _ '([<{"''' indexOf: char ifAbsent: [1].
+ 	left _ '([<{"''' at: which.
+ 	right _ ')]>}"''' at: which.
+ 	text _ paragraph text.
+ 	((startIndex > 1 and: [stopIndex <= text size])
+ 		and:
+ 		[(text at: startIndex-1) = left and: [(text at: stopIndex) = right]])
+ 		ifTrue:
+ 			["already enclosed; strip off brackets"
+ 			self selectFrom: startIndex-1 to: stopIndex.
+ 			self replaceSelectionWith: oldSelection]
+ 		ifFalse:
+ 			["not enclosed; enclose by matching brackets"
+ 			self replaceSelectionWith:
+ 				(Text string: (String with: left), oldSelection string ,(String with: right)
+ 					emphasis: emphasisHere).
+ 			self selectFrom: startIndex+1 to: stopIndex].
+ 	^true!

Item was changed:
  ----- Method: ParameterTile>>initialize (in category 'initialization') -----
  initialize
+ 	"Initialize the receiver"
+ 
- "initialize the state of the receiver"
  	super initialize.
+ 	type := #parameter.
+ 
- ""
  	self typeColor: Color red!

Item was added:
+ ----- Method: ParameterTile>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') -----
+ parseNodeWith: encoder
+ 
+ 	^ encoder encodeVariable: 'parameter' ifUnknown: [encoder encodeLiteral: 1].
+ !

Item was added:
+ ----- Method: ParameterTile>>scriptEditor: (in category '*Etoys-Squeakland-accessing') -----
+ scriptEditor: anEditor
+ 
+ 	scriptEditor _ anEditor.
+ !

Item was added:
+ ----- Method: ParameterTile>>sexpWith: (in category '*Etoys-Squeakland-code generation') -----
+ sexpWith: dictionary
+ 
+ 	| myTypeString n |
+ 	myTypeString _ self resultType.
+ 	(self scriptEditor hasParameter and: [self scriptEditor typeForParameter = myTypeString])
+ 		ifTrue:
+ 			[n _ SExpElement keyword: #variable.
+ 			(owner isMemberOf: TilePadMorph) ifTrue: [
+ 				n attributeAt: #type put: owner type
+ 			].
+ 			n attributeAt: #name put: 'parameter1']
+ 		ifFalse:
+ 			[self error: ''].
+ 	^ n.
+ !

Item was added:
+ ----- Method: ParseNode>>blockType (in category '*Etoys-Tweak-Kedama-accessing') -----
+ blockType
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #blockType) value!

Item was added:
+ ----- Method: ParseNode>>blockType: (in category '*Etoys-Tweak-Kedama-accessing') -----
+ blockType: t1 
+ 	KedamaEvaluatorNodeState
+ 		stateFor: self
+ 		at: #blockType
+ 		put: t1!

Item was added:
+ ----- Method: ParseNode>>canBeSpecialArgument (in category '*Etoys-Squeakland-testing') -----
+ canBeSpecialArgument
+ 	"Can I be an argument of (e.g.) ifTrue:?"
+ 
+ 	^false!

Item was added:
+ ----- Method: ParseNode>>defaultBlockType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultBlockType: t1 
+ 	^ #default!

Item was added:
+ ----- Method: ParseNode>>defaultMessageType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultMessageType
+ 	^ #none!

Item was added:
+ ----- Method: ParseNode>>eToysExpFlattenOn: (in category '*Etoys-Squeakland-accessing') -----
+ eToysExpFlattenOn: aStream
+ 
+ 	self isLeaf ifTrue: [aStream nextPut: self. ^ self].
+ 	
+ 	self getAllChildren do: [:c |
+ 		c eToysExpFlattenOn: aStream
+ 	].
+ !

Item was added:
+ ----- Method: ParseNode>>emitBranchOn:dist:pop:on: (in category '*Etoys-Squeakland-code generation') -----
+ emitBranchOn:
+ condition dist: dist pop: stack on: strm
+ 	stack pop: 1.
+ 	dist = 0 ifTrue: [^ strm nextPut: Pop].
+ 	condition
+ 		ifTrue: [self emitLong: dist code: BtpLong on: strm]
+ 		ifFalse: [self emitShortOrLong: dist code: Bfp on: strm]!

Item was added:
+ ----- Method: ParseNode>>emitForEffect:on: (in category '*Etoys-Squeakland-code generation') -----
+ emitForEffect: stack on: strm
+ 
+ 	self emitForValue: stack on: strm.
+ 	strm nextPut: Pop.
+ 	stack pop: 1!

Item was added:
+ ----- Method: ParseNode>>emitForReturn:on: (in category '*Etoys-Squeakland-code generation') -----
+ emitForReturn: stack on: strm
+ 
+ 	self emitForValue: stack on: strm.
+ 	strm nextPut: EndMethod!

Item was added:
+ ----- Method: ParseNode>>emitJump:on: (in category '*Etoys-Squeakland-code generation') -----
+ emitJump: dist on: strm
+ 
+ 	dist = 0 ifFalse: [self emitShortOrLong: dist code: Jmp on: strm]!

Item was added:
+ ----- Method: ParseNode>>emitLong:code:on: (in category '*Etoys-Squeakland-code generation') -----
+ emitLong: dist code: longCode on: aStream 
+ 	"Force a two-byte jump."
+ 	| code distance |
+ 	code _ longCode.
+ 	distance _ dist.
+ 	distance < 0
+ 		ifTrue: 
+ 			[distance _ distance + 1024.
+ 			code _ code - 4]
+ 		ifFalse: 
+ 			[distance > 1023 ifTrue: [distance _ -1]].
+ 	distance < 0
+ 		ifTrue: 
+ 			[self error: 'A block compiles more than 1K bytes of code']
+ 		ifFalse: 
+ 			[aStream nextPut: distance // 256 + code.
+ 			aStream nextPut: distance \\ 256]!

Item was added:
+ ----- Method: ParseNode>>emitShortOrLong:code:on: (in category '*Etoys-Squeakland-code generation') -----
+ emitShortOrLong: dist code: shortCode on: strm
+ 	(1 <= dist and: [dist <= JmpLimit])
+ 		ifTrue: [strm nextPut: shortCode + dist - 1]
+ 		ifFalse: [self emitLong: dist code: shortCode + (JmpLong-Jmp) on: strm]!

Item was added:
+ ----- Method: ParseNode>>firstInReceivers: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ firstInReceivers: t1 
+ 	^ t1 first!

Item was added:
+ ----- Method: ParseNode>>getAllChildren (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getAllChildren
+ 
+ 	self subclassResponsibility.
+ !

Item was added:
+ ----- Method: ParseNode>>getElderSiblingOf: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getElderSiblingOf: node
+ 
+ 	self subclassResponsibility.
+ !

Item was added:
+ ----- Method: ParseNode>>getFirstChild (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getFirstChild
+ 
+ 	self subclassResponsibility.
+ !

Item was added:
+ ----- Method: ParseNode>>getLastChild (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getLastChild
+ 
+ 	self subclassResponsibility.
+ !

Item was added:
+ ----- Method: ParseNode>>isFirstChild: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isFirstChild: childNode
+ 
+ 	self subclassResponsibility.
+ !

Item was added:
+ ----- Method: ParseNode>>isInTest (in category '*Etoys-Tweak-Kedama-accessing') -----
+ isInTest
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #isInTest) value!

Item was added:
+ ----- Method: ParseNode>>isInTest: (in category '*Etoys-Tweak-Kedama-accessing') -----
+ isInTest: t1 
+ 	KedamaEvaluatorNodeState
+ 		stateFor: self
+ 		at: #isInTest
+ 		put: t1!

Item was added:
+ ----- Method: ParseNode>>isLastChild: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isLastChild: childNode
+ 
+ 	self subclassResponsibility.
+ !

Item was added:
+ ----- Method: ParseNode>>isLeaf (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isLeaf
+ 
+ 	^ false.
+ !

Item was added:
+ ----- Method: ParseNode>>isStatement (in category '*Etoys-Tweak-Kedama-accessing') -----
+ isStatement
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #isStatement) value!

Item was added:
+ ----- Method: ParseNode>>isStatement: (in category '*Etoys-Tweak-Kedama-accessing') -----
+ isStatement: t1 
+ 	KedamaEvaluatorNodeState
+ 		stateFor: self
+ 		at: #isStatement
+ 		put: t1!

Item was added:
+ ----- Method: ParseNode>>isStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isStmt: t1 
+ 	^ t1 = #top
+ 		or: [t1 = #condition]!

Item was added:
+ ----- Method: ParseNode>>isTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTest: t1 parentNode: t2 
+ 	t1 = true
+ 		ifTrue: [^ true].
+ 	^ (t2 isMemberOf: MessageNode)
+ 		and: [t2 receiver = self
+ 				and: [t2 messageType value = #condition]]!

Item was added:
+ ----- Method: ParseNode>>isTopStatement (in category '*Etoys-Tweak-Kedama-accessing') -----
+ isTopStatement
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #isTopStatement) value!

Item was added:
+ ----- Method: ParseNode>>isTopStatement: (in category '*Etoys-Tweak-Kedama-accessing') -----
+ isTopStatement: t1 
+ 	KedamaEvaluatorNodeState
+ 		stateFor: self
+ 		at: #isTopStatement
+ 		put: t1!

Item was added:
+ ----- Method: ParseNode>>isTopStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmt: t1 
+ 	t1 = nil
+ 		ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: ParseNode>>messageType (in category '*Etoys-Tweak-Kedama-accessing') -----
+ messageType
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #messageType) value!

Item was added:
+ ----- Method: ParseNode>>messageType: (in category '*Etoys-Tweak-Kedama-accessing') -----
+ messageType: t1 
+ 	KedamaEvaluatorNodeState
+ 		stateFor: self
+ 		at: #messageType
+ 		put: t1!

Item was added:
+ ----- Method: ParseNode>>myNode (in category '*Etoys-Tweak-Kedama-accessing') -----
+ myNode
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #myNode) value!

Item was added:
+ ----- Method: ParseNode>>myNode: (in category '*Etoys-Tweak-Kedama-accessing') -----
+ myNode: t1 
+ 	KedamaEvaluatorNodeState
+ 		stateFor: self
+ 		at: #myNode
+ 		put: t1!

Item was added:
+ ----- Method: ParseNode>>nodeInfoIn (in category '*Etoys-Tweak-Kedama-accessing') -----
+ nodeInfoIn
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #nodeInfoIn) value!

Item was added:
+ ----- Method: ParseNode>>nodeInfoIn: (in category '*Etoys-Tweak-Kedama-accessing') -----
+ nodeInfoIn: t1 
+ 	KedamaEvaluatorNodeState
+ 		stateFor: self
+ 		at: #nodeInfoIn
+ 		put: t1!

Item was added:
+ ----- Method: ParseNode>>nodeInfoOut (in category '*Etoys-Tweak-Kedama-accessing') -----
+ nodeInfoOut
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #nodeInfoOut) value!

Item was added:
+ ----- Method: ParseNode>>nodeInfoOut: (in category '*Etoys-Tweak-Kedama-accessing') -----
+ nodeInfoOut: t1 
+ 	KedamaEvaluatorNodeState
+ 		stateFor: self
+ 		at: #nodeInfoOut
+ 		put: t1!

Item was added:
+ ----- Method: ParseNode>>noop: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ noop: anObject
+ !

Item was added:
+ ----- Method: ParseNode>>normalize (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ normalize
+ 
+ 	self getAllChildren do: [:child |
+ 		child isLeaf ifTrue: [
+ 			self replaceNode: child with: child clone.
+ 		] ifFalse: [
+ 			child normalize.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: ParseNode>>primaryBreedPair (in category '*Etoys-Tweak-Kedama-accessing') -----
+ primaryBreedPair
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #primaryBreedPair) value!

Item was added:
+ ----- Method: ParseNode>>primaryBreedPair: (in category '*Etoys-Tweak-Kedama-accessing') -----
+ primaryBreedPair: t1 
+ 	KedamaEvaluatorNodeState
+ 		stateFor: self
+ 		at: #primaryBreedPair
+ 		put: t1!

Item was added:
+ ----- Method: ParseNode>>rawblockType (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rawblockType
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #blockType!

Item was added:
+ ----- Method: ParseNode>>rawisInTest (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rawisInTest
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #isInTest!

Item was added:
+ ----- Method: ParseNode>>rawisStatement (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rawisStatement
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #isStatement!

Item was added:
+ ----- Method: ParseNode>>rawisTopStatement (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rawisTopStatement
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #isTopStatement!

Item was added:
+ ----- Method: ParseNode>>rawmessageType (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rawmessageType
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #messageType!

Item was added:
+ ----- Method: ParseNode>>rawmyNode (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rawmyNode
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #myNode!

Item was added:
+ ----- Method: ParseNode>>rawnodeInfoIn (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rawnodeInfoIn
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #nodeInfoIn!

Item was added:
+ ----- Method: ParseNode>>rawnodeInfoOut (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rawnodeInfoOut
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #nodeInfoOut!

Item was added:
+ ----- Method: ParseNode>>rawprimaryBreedPair (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rawprimaryBreedPair
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #primaryBreedPair!

Item was added:
+ ----- Method: ParseNode>>rawreceiverObject (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rawreceiverObject
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #receiverObject!

Item was added:
+ ----- Method: ParseNode>>rawrewriteInfoIn (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rawrewriteInfoIn
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #rewriteInfoIn!

Item was added:
+ ----- Method: ParseNode>>rawrewriteInfoOut (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rawrewriteInfoOut
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #rewriteInfoOut!

Item was added:
+ ----- Method: ParseNode>>rawrvr (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rawrvr
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #rvr!

Item was added:
+ ----- Method: ParseNode>>rawstatementType (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rawstatementType
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #statementType!

Item was added:
+ ----- Method: ParseNode>>rawstmtChain (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rawstmtChain
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #stmtChain!

Item was added:
+ ----- Method: ParseNode>>rawxxxOccurences (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rawxxxOccurences
+ 	^ KedamaEvaluatorNodeState stateFor: self at: #xxxOccurences!

Item was added:
+ ----- Method: ParseNode>>rcvr: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr: t1 
+ 	^ t1!

Item was added:
+ ----- Method: ParseNode>>receiverObject (in category '*Etoys-Tweak-Kedama-accessing') -----
+ receiverObject
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #receiverObject) value!

Item was added:
+ ----- Method: ParseNode>>receiverObject: (in category '*Etoys-Tweak-Kedama-accessing') -----
+ receiverObject: t1 
+ 	KedamaEvaluatorNodeState
+ 		stateFor: self
+ 		at: #receiverObject
+ 		put: t1!

Item was added:
+ ----- Method: ParseNode>>replaceNode:with: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ replaceNode: childNode with: newNode
+ 
+ 	self subclassResponsibility.
+ !

Item was added:
+ ----- Method: ParseNode>>rewriteInfoIn (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rewriteInfoIn
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #rewriteInfoIn) value!

Item was added:
+ ----- Method: ParseNode>>rewriteInfoIn: (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rewriteInfoIn: t1 
+ 	KedamaEvaluatorNodeState
+ 		stateFor: self
+ 		at: #rewriteInfoIn
+ 		put: t1!

Item was added:
+ ----- Method: ParseNode>>rewriteInfoOut (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rewriteInfoOut
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #rewriteInfoOut) value!

Item was added:
+ ----- Method: ParseNode>>rewriteInfoOut: (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rewriteInfoOut: t1 
+ 	KedamaEvaluatorNodeState
+ 		stateFor: self
+ 		at: #rewriteInfoOut
+ 		put: t1!

Item was added:
+ ----- Method: ParseNode>>rvr (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rvr
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #rvr) value!

Item was added:
+ ----- Method: ParseNode>>rvr: (in category '*Etoys-Tweak-Kedama-accessing') -----
+ rvr: t1 
+ 	KedamaEvaluatorNodeState
+ 		stateFor: self
+ 		at: #rvr
+ 		put: t1!

Item was added:
+ ----- Method: ParseNode>>sizeBranchOn:dist: (in category '*Etoys-Squeakland-code generation') -----
+ sizeBranchOn: condition dist: dist
+ 	dist = 0 ifTrue: [^1].
+ 	^ condition
+ 		ifTrue: [2]  "Branch on true is always 2 bytes"
+ 		ifFalse: [self sizeShortOrLong: dist]!

Item was added:
+ ----- Method: ParseNode>>sizeForEffect: (in category '*Etoys-Squeakland-code generation') -----
+ sizeForEffect: encoder
+ 
+ 	^(self sizeForValue: encoder) + 1!

Item was added:
+ ----- Method: ParseNode>>sizeForReturn: (in category '*Etoys-Squeakland-code generation') -----
+ sizeForReturn: encoder
+ 
+ 	^(self sizeForValue: encoder) + 1!

Item was added:
+ ----- Method: ParseNode>>sizeJump: (in category '*Etoys-Squeakland-code generation') -----
+ sizeJump: dist
+ 
+ 	dist = 0 ifTrue: [^0].
+ 	^self sizeShortOrLong: dist!

Item was added:
+ ----- Method: ParseNode>>sizeShortOrLong: (in category '*Etoys-Squeakland-code generation') -----
+ sizeShortOrLong: dist
+ 
+ 	(1 <= dist and: [dist <= JmpLimit])
+ 		ifTrue: [^1].
+ 	^2!

Item was added:
+ ----- Method: ParseNode>>statementType (in category '*Etoys-Tweak-Kedama-accessing') -----
+ statementType
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #statementType) value!

Item was added:
+ ----- Method: ParseNode>>statementType: (in category '*Etoys-Tweak-Kedama-accessing') -----
+ statementType: t1 
+ 	KedamaEvaluatorNodeState
+ 		stateFor: self
+ 		at: #statementType
+ 		put: t1!

Item was added:
+ ----- Method: ParseNode>>stmtChain (in category '*Etoys-Tweak-Kedama-accessing') -----
+ stmtChain
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #stmtChain) value!

Item was added:
+ ----- Method: ParseNode>>stmtChain: (in category '*Etoys-Tweak-Kedama-accessing') -----
+ stmtChain: t1 
+ 	KedamaEvaluatorNodeState
+ 		stateFor: self
+ 		at: #stmtChain
+ 		put: t1!

Item was added:
+ ----- Method: ParseNode>>thisNode (in category '*Etoys-Tweak-Kedama-Generated') -----
+ thisNode
+ 	^ self!

Item was added:
+ ----- Method: ParseNode>>transfer: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 
+ 	^ t1!

Item was added:
+ ----- Method: ParseNode>>transferAttribute: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ transferAttribute: arg
+ 
+ 	^ arg first.
+ !

Item was added:
+ ----- Method: ParseNode>>xxxOccurences (in category '*Etoys-Tweak-Kedama-accessing') -----
+ xxxOccurences
+ 	^ (KedamaEvaluatorNodeState stateFor: self at: #xxxOccurences) value!

Item was added:
+ ----- Method: ParseNode>>xxxOccurences: (in category '*Etoys-Tweak-Kedama-accessing') -----
+ xxxOccurences: t1 
+ 	KedamaEvaluatorNodeState
+ 		stateFor: self
+ 		at: #xxxOccurences
+ 		put: t1!

Item was added:
+ Object subclass: #ParseNodeAttribute
+ 	instanceVariableNames: 'grammarClass attributeName type rules setter rawGetter'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tweak-Kedama-ParseTreeTransformer'!

Item was added:
+ ----- Method: ParseNodeAttribute>>addRule: (in category 'all') -----
+ addRule: aSemanticRule
+ 
+ 	| newRules |
+ 	newRules _ Array new: rules size + 1.
+ 	newRules at: 1 put: aSemanticRule.
+ 	newRules replaceFrom: 2 to: newRules size with: rules startingAt: 1.
+ 	rules _ newRules.
+ !

Item was added:
+ ----- Method: ParseNodeAttribute>>addRules: (in category 'all') -----
+ addRules: semanticRules
+ 
+ 	rules _ rules, semanticRules.
+ !

Item was added:
+ ----- Method: ParseNodeAttribute>>attributeName (in category 'all') -----
+ attributeName
+ 
+ 	^ attributeName.
+ !

Item was added:
+ ----- Method: ParseNodeAttribute>>attributeName: (in category 'all') -----
+ attributeName: aSymbol
+ 
+ 	attributeName _ aSymbol.
+ 	setter _ (attributeName, ':') asSymbol.
+ 	rawGetter _ ('raw', attributeName) asSymbol.
+ 	"rawGetter _ attributeName asSymbol."
+ 
+ !

Item was added:
+ ----- Method: ParseNodeAttribute>>grammarClass (in category 'all') -----
+ grammarClass
+ 
+ 	^ grammarClass.
+ !

Item was added:
+ ----- Method: ParseNodeAttribute>>grammarClass: (in category 'all') -----
+ grammarClass: aClass
+ 
+ 	grammarClass _ aClass.
+ !

Item was added:
+ ----- Method: ParseNodeAttribute>>initialize (in category 'all') -----
+ initialize
+ 
+ 	rules _ Array new.
+ !

Item was added:
+ ----- Method: ParseNodeAttribute>>printOn: (in category 'all') -----
+ printOn: aStream
+ 
+ 	aStream
+ 		nextPutAll: 'Attribute(';
+ 		nextPutAll: attributeName;
+ 		nextPutAll: ', ';
+ 		nextPutAll: grammarClass name;
+ 		nextPutAll: ')'.
+ 
+ !

Item was added:
+ ----- Method: ParseNodeAttribute>>rawGetter (in category 'all') -----
+ rawGetter
+ 
+ 	^ rawGetter.
+ !

Item was added:
+ ----- Method: ParseNodeAttribute>>rules (in category 'all') -----
+ rules
+ 
+ 	^ rules.
+ !

Item was added:
+ ----- Method: ParseNodeAttribute>>setter (in category 'all') -----
+ setter
+ 
+ 	^ setter.
+ !

Item was added:
+ ----- Method: ParseNodeAttribute>>type (in category 'all') -----
+ type
+ 
+ 	^ type.!

Item was added:
+ ----- Method: ParseNodeAttribute>>type: (in category 'all') -----
+ type: aSymbol
+ 
+ 	type _ aSymbol.
+ !

Item was added:
+ ParseNodeAttribute subclass: #ParseNodeAttributeOccurence
+ 	instanceVariableNames: 'node value dependencies selectedRule inputSizes sortInTime sortOutTime'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tweak-Kedama-ParseTreeTransformer'!

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>addSource: (in category 'all') -----
+ addSource: anOccurence
+ 
+ 	dependencies nextPut: anOccurence.
+ !

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>attributeName: (in category 'all') -----
+ attributeName: aSymbol
+ 
+ 	attributeName _ aSymbol.
+ !

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>dependencies (in category 'all') -----
+ dependencies
+ 
+ 	^ dependencies contents.
+ !

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>inTime (in category 'all') -----
+ inTime
+ 
+ 	^ sortInTime.
+ !

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>inTime: (in category 'all') -----
+ inTime: aValue
+ 
+ 	sortInTime _ aValue.
+ !

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>initialize (in category 'all') -----
+ initialize
+ 
+ 	super initialize.
+ 	dependencies _ WriteStream on: (Array new: 8).
+ 	sortInTime _ -1.
+ 	sortOutTime _ -1.
+ !

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>inputSizeAt:put: (in category 'all') -----
+ inputSizeAt: index put: size
+ 
+ 	inputSizes at: index put: size.
+ !

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>inputSizes (in category 'all') -----
+ inputSizes
+ 
+ 	^ inputSizes.
+ !

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>node (in category 'all') -----
+ node
+ 
+ 	^ node.
+ !

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>node: (in category 'all') -----
+ node: aParseNode
+ 
+ 	node _ aParseNode.
+ !

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>outTime (in category 'all') -----
+ outTime
+ 
+ 	^ sortOutTime.
+ !

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>outTime: (in category 'all') -----
+ outTime: aValue
+ 
+ 	sortOutTime _ aValue.!

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>printOn: (in category 'all') -----
+ printOn: aStream
+ 
+ 	aStream
+ 		nextPutAll: 'Occurence(';
+ 		nextPutAll: attributeName;
+ 		nextPutAll: ', ';
+ 		nextPutAll: grammarClass name;
+ 		nextPutAll: ', ';
+ 		nextPutAll: (value printString ifNil: ['nil']);
+ 		nextPutAll: ')'.
+ 
+ !

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>rawGetter: (in category 'all') -----
+ rawGetter: aSymbol
+ 
+ 	rawGetter _ aSymbol.
+ !

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>selectedRule (in category 'all') -----
+ selectedRule
+ 
+ 	^ selectedRule.
+ !

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>selectedRule: (in category 'all') -----
+ selectedRule: aSemanticRule
+ 
+ 	selectedRule _ aSemanticRule.
+ 	inputSizes _ Array new: aSemanticRule inputSpecs size.
+ !

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>setter: (in category 'all') -----
+ setter: aSymbol
+ 
+ 	setter _ aSymbol.
+ !

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>value (in category 'all') -----
+ value
+ 
+ 	^ value.
+ !

Item was added:
+ ----- Method: ParseNodeAttributeOccurence>>value: (in category 'all') -----
+ value: anObject
+ 
+ 	value _ anObject.
+ !

Item was added:
+ ----- Method: Parser>>init:notifying:failBlock: (in category '*Etoys-Squeakland-private') -----
+ init: sourceStream notifying: req failBlock: aBlock
+ 
+ 	requestor _ req.
+ 	failBlock _ aBlock.
+ 	super scan: sourceStream.
+ 	prevMark _ hereMark _ mark.
+ 	requestorOffset _ 0.
+ 	self advance!

Item was added:
+ ----- Method: Parser>>method:context:encoder: (in category '*Etoys-Squeakland-expression types') -----
+ method: doit context: ctxt encoder: encoderToUse
+ 	" pattern [ | temporaries ] block => MethodNode."
+ 
+ 	| sap blk prim temps messageComment methodNode |
+ 	properties := AdditionalMethodState new.
+ 	encoder := encoderToUse.
+ 	sap := self pattern: doit inContext: ctxt.
+ 	"sap={selector, arguments, precedence}"
+ 	properties selector: (sap at: 1).
+ 	(sap at: 2) do: [:argNode | argNode isArg: true].
+ 	doit ifFalse: [self pragmaSequence].
+ 	temps := self temporaries.
+ 	messageComment := currentComment.
+ 	currentComment := nil.
+ 	doit ifFalse: [self pragmaSequence].
+ 	prim := self pragmaPrimitives.
+ 	self statements: #() innerBlock: doit.
+ 	blk := parseNode.
+ 	doit ifTrue: [blk returnLast]
+ 		ifFalse: [blk returnSelfIfNoOther].
+ 	hereType == #doIt ifFalse: [^self expected: 'Nothing more'].
+ 	self interactive ifTrue: [self removeUnusedTemps].
+ 	methodNode := self newMethodNode comment: messageComment.
+ 	^methodNode
+ 		selector: (sap at: 1)
+ 		arguments: (sap at: 2)
+ 		precedence: (sap at: 3)
+ 		temporaries: temps
+ 		block: blk
+ 		encoder: encoder
+ 		primitive: prim
+ 		properties: properties!

Item was added:
+ ----- Method: Parser>>parseArgsAndTemps:notifying: (in category '*Etoys-Squeakland-public access') -----
+ parseArgsAndTemps: aString notifying: req 
+         "Parse the argument, aString, notifying req if an error occurs. Otherwise, 
+         answer a two-element Array containing Arrays of strings (the argument 
+         names and temporary variable names)."
+ 
+         (req notNil and: [RequestAlternateSyntaxSetting signal]) ifTrue:
+                 [^ (self as: DialectParser) parseArgsAndTemps: aString notifying: req].
+         aString == nil ifTrue: [^#()].
+         doitFlag _ false.               "Don't really know if a doit or not!!"
+         ^self initPattern: aString
+                 notifying: req
+                 return: [:pattern | (pattern at: 2) , (self temporariesIn: (pattern at: 1))]!

Item was added:
+ ----- Method: Parser>>primitive (in category '*Etoys-Squeakland-primitives') -----
+ primitive
+ 	| n |
+ 	(self matchToken: #<) ifFalse: [^ 0].
+ 	n _ self primitiveDeclarations.
+ 	(self matchToken: #>) ifFalse: [^ self expected: '>'].
+ 	^ n!

Item was added:
+ ----- Method: PartsBin class>>cacheSpecialThumbnails (in category '*Etoys-Squeakland-thumbnail cache') -----
+ cacheSpecialThumbnails
+ 	"A few special cases..."
+ 
+ 	Thumbnails at: 'number' put: (Thumbnail new makeThumbnailFromForm:
+  (Form extent: 42 at 14 depth: 16 fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 26386 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398098 26386 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398098 26386 1744398329 1744398329 1744398329 724199417 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398098 26386 1744398329 1744398329 1744382762 724183850 724199417 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398098 26386 1744398329 1744398329 724183850 724183850 724183850 1744398329 1744398329 1744398329 1744385549 279183361 65537 65537 65537 73031 1744398329 1744398329 1744398329 1744398329 1744398329 1744398098 26386 1744398329 1744382762 724183850 724183850 724183850 724199417 1744398329 1744398329 281281569 629762041 1744398329 1744398329 1744398329 1744398329 1744398329 724183850 724183850 1744398329 1744398329 1744398098 26386 1744382762 724183850 724183850 724183850 724183850 724183850 1744398329 1744390898 66593 66593 69271553 69275812 1257400313 1744398329 1744398329 724183850 724183850 724183850 1744398329 1744398098 26386 1744382762 724183850 724183850 724183850 724183850 724183850 1744398329 1744396183 489107948 1536583673 1744398329 1257377956 69272641 71391061 1744398329 724183850 724183850 724183850 1744398329 1744398098 26386 1744398329 1744382762 724183850 724183850 724183850 724199417 1744398329 1744386606 976119801 1744398329 1744398329 1744398329 71368705 83633 1744398329 724183850 724183850 1744398329 1744398329 1744398098 26386 1744398329 1744398329 724183850 724183850 724183850 1744398329 1744398329 1744377029 66593 69828 281285861 69271553 69284332 837576697 1744398329 724199417 1744398329 1744398329 1744398329 1744398098 26386 1744398329 1744398329 1744382762 724183850 724199417 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398098 26386 1744398329 1744398329 1744398329 724199417 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398098 26386 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398329 1744398098) offset: 0 at 0)).
+ 
+ 	Thumbnails at: 'numeric expression' put: (Thumbnail new makeThumbnailFromForm:
+  (Form extent: 69 at 18 depth: 16 fromArray: #( 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403343781 1403322368 1403347960 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677197312 1403347960 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677197312 1403347960 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677197312 1403347960 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677198369 91128 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677197312 1403347960 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677197313 91128 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677197312 1403347960 1677222904 1677222904 1188120305 1677218644 1469408248 1677218644 770401272 1116759032 1398025708 770398101 1677222904 1118856184 770387436 1677222904 1677215441 1190224888 1677222904 1677217587 770387435 1677222904 1677222904 1328754155 770389549 1677214352 908944376 1677222904 1677209067 770464662 1677222904 1116740935 1677216530 770397012 1677222904 1677197312 1403347960 1677222904 1469393354 69271553 1118836998 839672824 1677198402 69293973 69281161 65537 69275812 1677217555 71439622 69271553 1677222904 701105185 82608 1677222904 1051721729 69272609 1257399288 1677213360 66593 69271553 1677198369 2122744 1677219733 491258913 66626 1677222904 69272576 142804001 69273698 1677222904 1677197312 1403347960 1677222904 79437 1677218644 2122744 69272642 560540074 1677215441 69284364 1469408248 1677198369 1677222904 81519 1677222904 1677201605 911041528 1398013984 1677198369 491217912 1677215474 1677222904 69279047 1677222904 1190286164 1677198369 2122744 1677197313 629761016 1677197313 1677222904 69271553 1188127736 69271553 1677222904 1677197312 1403347960 1677213295 629761016 978191426 419849208 560463873 91128 1677215473 91128 1677222904 1677197313 1677222904 2122744 1677222904 1047461889 1677212238 71440646 1677197313 1536567722 71368705 1188127736 88982 699008065 66592 1677197313 2122744 1047465091 1469408248 1677197313 1677222904 65568 1677222904 65537 1677222904 1677197312 1403347960 1677197313 65537 980307763 1677222904 770375681 91128 1677212270 91128 1677220758 142817902 1677215473 212034552 1677222904 65537 80494 1328767992 1677197313 79405 1469397614 281306104 65537 908941205 980287489 1677197313 419842834 91128 1677222904 1677197313 1677222904 67682 1677222904 65568 1677222904 1677197312 1403347960 1677197313 1188127736 1677219733 348480504 69271553 71443849 1677210092 69297144 1677202694 69297144 1677215441 419849208 1677222904 67682 1677222904 1469387973 1677222904 1677222904 1677203718 1047487480 1677222904 1677222904 419823617 1677198369 419842802 91128 1677222904 1118831682 1677222904 69277958 1677222904 69271584 1677222904 1677197312 1403347960 1677197313 281285894 69271553 1398017155 839672824 1677197313 140653036 69272609 76202 1536582648 1677207978 1118856184 1677222904 66593 352715809 86868 768279585 142808326 69279048 1677209035 69273731 352715809 491280277 1677198369 1118856184 281280513 69272609 71459832 1677222904 69282218 1677222904 69281161 1677222904 1677197312 1403347960 1677214384 65537 699025137 1677210157 1677222904 1677211181 770388460 70886 491217912 1677222904 1677215473 1677222904 1677222904 1118831681 76202 1190224888 1677204775 69829 560555000 1677222904 489095169 281354601 1677222904 1677204775 1398039544 1536557057 73031 1398039544 1677222904 770399126 1677222904 770393841 1677222904 1677197312 1403347960 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677203718 91128 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677197312 1403347960 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677203718 69297144 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677197312 1403347960 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677198402 212034552 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677197312 1403347960 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677204808 908944376 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677222904 1677197312)
+ 	offset: 0 at 0)).
+ 
+ "
+ PartsBin cacheSpecialThumbnails
+ "!

Item was added:
+ ----- Method: PartsBin class>>newPartsBinWithOrientation:andColor:from:withPreviousEntries: (in category '*Etoys-Squeakland-instance creation') -----
+ newPartsBinWithOrientation: aListDirection andColor: aColor from: quadList withPreviousEntries: aCollection
+ 	"Answer a new PartBin object, to run horizontally or vertically,  
+ 	obtaining its elements from the list of tuples of the form:  
+ 	(<receiver> <selector> <label> <balloonHelp>)"
+ 	^ (self new)
+ 		color: aColor;
+ 		listDirection: aListDirection quadList: (self translatedQuads: quadList) withPreviousEntries: aCollection.!

Item was added:
+ ----- Method: PartsBin class>>rebuildIconsWithProgress (in category '*Etoys-Squeakland-thumbnail cache') -----
+ rebuildIconsWithProgress
+ 	"Put up an eye-catching progress morph while doing a complete rebuild of all the parts icons in the system."
+ 
+ 	| fixBlock |
+ 	fixBlock _ Project current displayProgressWithJump: 'Building icons' translated.
+ 	self clearThumbnailCache.
+ 	self cacheAllThumbnails.
+ 	fixBlock value.
+ 	ActiveWorld ifNotNil: [ActiveWorld fullRepaintNeeded]!

Item was added:
+ ----- Method: PartsBin class>>reconstructAllPartsIcons (in category '*Etoys-Squeakland-thumbnail cache') -----
+ reconstructAllPartsIcons
+ 	"Reconstruct all the parts icon.  Show a progress bar."
+ 
+ 	| wasEnabled wereAnnotations |
+ 
+ 	Cursor wait showWhile:
+ 		[TabbedPalette unload.
+ 		wasEnabled := Preferences eToyFriendly.
+ 		wereAnnotations := Preferences annotationPanes.
+ 		Preferences enable: #eToyFriendly.
+ 		Preferences disable: #annotationPanes.
+ 		self rebuildIconsWithProgress..
+ 		Flaps registeredFlapsQuads at: 'PlugIn Supplies' put: Flaps defaultsQuadsDefiningPlugInSuppliesFlap.
+ 		Flaps replaceGlobalFlapwithID: 'Supplies'.
+ 		wasEnabled ifFalse: [Preferences disable: #eToyFriendly].
+ 		wereAnnotations ifTrue: [Preferences enable: #annotationPanes]]
+ 
+ "
+ PartsBin reconstructAllPartsIcons.
+ "
+ 
+ 
+ !

Item was added:
+ ----- Method: PartsBin class>>uncacheThumbnailFor: (in category '*Etoys-Squeakland-thumbnail cache') -----
+ uncacheThumbnailFor: aKey
+ 	"Uncache the thumbnail associated with the argument, if any."
+ 
+ 	Thumbnails removeKey: aKey ifAbsent: []!

Item was added:
+ ----- Method: PartsBin>>listDirection:quadList:withPreviousEntries: (in category '*Etoys-Squeakland-initialization') -----
+ listDirection: aListDirection quadList: quadList withPreviousEntries: aCollection
+ 	"Initialize the receiver to run horizontally or vertically, obtaining its elements from the list of tuples of the form:
+ 		(<receiver> <selector> <label> <balloonHelp>)"
+ 
+ 	| aButton aClass oldDict |
+ 	self layoutPolicy: TableLayout new.
+ 	self listDirection: aListDirection.
+ 	self wrapCentering: #topLeft.
+ 	self layoutInset: 2.
+ 	self cellPositioning: #bottomCenter.
+ 
+ 	oldDict _ Dictionary new.
+ 	aCollection ifNotNil: [
+ 		aCollection do: [:e | oldDict at: e target put: e]
+ 	].
+ 	aListDirection == #leftToRight
+ 		ifTrue:
+ 			[self vResizing: #rigid.
+ 			self hResizing: #spaceFill.
+ 			self wrapDirection: #topToBottom]
+ 		ifFalse:
+ 			[self hResizing: #rigid.
+ 			self vResizing: #spaceFill.
+ 			self wrapDirection: #leftToRight].
+ 	quadList do:
+ 		[:tuple |
+ 			aClass _ Smalltalk at: tuple first.
+ 			aButton _ oldDict at: aClass ifAbsent: [].
+ 			(aButton isNil or: [#(TextMorph ScriptableButton) includes: aClass name]) ifTrue: [
+ 				aButton _ IconicButtonWithLabel new initializeWithThumbnail: (self class thumbnailForQuad: tuple color: self color) withLabel: tuple third andColor: self color andSend: tuple second to: aClass.
+ 				(tuple size > 3 and: [tuple fourth isEmptyOrNil not]) ifTrue:
+ 					[aButton setBalloonText: tuple fourth].
+ 			] ifFalse: [
+ 				aButton labelString: tuple third.
+ 				aButton arguments: {aButton arguments first. tuple third}.
+ 				(tuple size > 3 and: [tuple fourth isEmptyOrNil not]) ifTrue:
+ 					[aButton setBalloonText: tuple fourth].
+ 			].
+  			self addMorphBack: aButton]!

Item was added:
+ ----- Method: PartsBin>>restoreUserDefinedObjectsFrom: (in category '*Etoys-Squeakland-saving/loading') -----
+ restoreUserDefinedObjectsFrom: anArray
+ 
+ 	| aButton m |
+ 	anArray do: [:pair |
+ 		aButton _ IconicButton new.
+ 		m _ pair second sissReadObjects.
+ 		aButton color: self color;
+ 			initializeToShow: m withLabel: pair first andSend: #veryDeepCopy to: m.
+ 		self addMorphBack: aButton
+ 	].
+ !

Item was added:
+ ----- Method: PartsBin>>savedUserDefinedObjects (in category '*Etoys-Squeakland-saving/loading') -----
+ savedUserDefinedObjects
+ 
+ 	^ ((self submorphs select: [:e | (e isKindOf: IconicButton) and: [(e actionSelector numArgs = 2) and: [e arguments first = #veryDeepCopy]]]) collect: [:e | Array with: e arguments second with: e target sissScanObjectsForMorphCopy]).
+ !

Item was added:
+ SystemWindow subclass: #PartsWindow
+ 	instanceVariableNames: 'book prevButton nextButton menuButton openForEditing'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-PartsBin'!
+ 
+ !PartsWindow commentStamp: '<historical>' prior: 0!
+ Disused.  Instances may persist in users' images, so this obsolete code is kept around for the time being.  Supplanted by the ObjectsTool.!

Item was added:
+ ----- Method: PartsWindow>>addCustomMenuItems:hand: (in category 'menus') -----
+ addCustomMenuItems: aCustomMenu hand: aHandMorph
+ 	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ 	aCustomMenu add: 'parts window controls...' translated action: #invokePartsWindowMenu
+ !

Item was added:
+ ----- Method: PartsWindow>>adjustBookControls (in category 'as yet unclassified') -----
+ adjustBookControls
+ 	| inner |
+ 	prevButton ifNil: [^ self].
+ 	prevButton align: prevButton topLeft with: (inner _ self innerBounds) topLeft + (32 @ -1).
+ 	nextButton align: nextButton topRight with: inner topRight - (18 @ 1).
+ 	menuButton align: menuButton topLeft with: inner topRight + (-42 @ 5).!

Item was added:
+ ----- Method: PartsWindow>>book: (in category 'as yet unclassified') -----
+ book: aBook
+ 
+ 	book _ aBook.
+ 	self addMorph: aBook frame: (0 at 0 extent: 1 at 1).
+ 	book beSticky.
+ 	self extent: aBook extent + (0 at self labelHeight).
+ 	nextButton target: aBook.
+ 	prevButton target: aBook!

Item was added:
+ ----- Method: PartsWindow>>closeEditing (in category 'as yet unclassified') -----
+ closeEditing
+ 	openForEditing _ false.
+ 	self color: Color white.
+ 	book pages do:
+ 		[:aPage | aPage setPartsBinStatusTo: true]!

Item was added:
+ ----- Method: PartsWindow>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color white!

Item was added:
+ ----- Method: PartsWindow>>extent: (in category 'geometry') -----
+ extent: newExtent
+ 	super extent: (newExtent max: 100 @ 50).
+ 	self adjustBookControls!

Item was added:
+ ----- Method: PartsWindow>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	| aFont aForm |
+ 	super initialize.
+ 	""
+ 	
+ 	openForEditing _ false.
+ 	aFont _ Preferences standardButtonFont.
+ 	self addMorph: (prevButton _ SimpleButtonMorph new borderWidth: 0;
+ 					 label: '<' font: aFont;
+ 					 color: Color transparent;
+ 					 setBalloonText: 'previous page';
+ 					 actionSelector: #previousPage;
+ 					 target: self;
+ 					 extent: 16 @ 16).
+ 	self addMorph: (nextButton _ SimpleButtonMorph new borderWidth: 0;
+ 					 label: '>' font: aFont;
+ 					 color: Color transparent;
+ 					 setBalloonText: 'next page';
+ 					 actionSelector: #nextPage;
+ 					 target: self;
+ 					 extent: 16 @ 16).
+ 	menuButton _ ThreePhaseButtonMorph new onImage: (aForm _ ScriptingSystem formAtKey: 'OfferToUnlock');
+ 				
+ 				offImage: (ScriptingSystem formAtKey: 'OfferToLock');
+ 				
+ 				pressedImage: (ScriptingSystem formAtKey: 'OfferToLock');
+ 				 extent: aForm extent;
+ 				 state: #on.
+ 	menuButton target: self;
+ 		 actionSelector: #toggleStatus;
+ 		 actWhen: #buttonUp.
+ 	menuButton setBalloonText: 'open for editing'.
+ 	self addMorph: menuButton.
+ 	" 
+ 	self addMorph: (menuButton _ SimpleButtonMorph new  
+ 	borderWidth: 0;  
+ 	label: '·' font: aFont; color: Color transparent;  
+ 	actWhen: #buttonDown;  
+ 	actionSelector: #invokePartsWindowMenu; target: self; extent:  
+ 	16 at 16)."
+ 	self adjustBookControls!

Item was added:
+ ----- Method: PartsWindow>>invokePartsWindowMenu (in category 'as yet unclassified') -----
+ invokePartsWindowMenu
+ 	"Put up a menu offering parts-bin controls"
+ 
+ 	| aMenu sel |
+ 	aMenu _ MVCMenuMorph new.
+ 	aMenu defaultTarget: aMenu.
+ 	openForEditing
+ 		ifTrue:
+ 			[aMenu add: 'resume being a parts bin' selector: #selectMVCItem: argument:	#toggleStatus]
+ 		ifFalse:
+ 			[aMenu add: 'open for editing' selector: #selectMVCItem: argument:#toggleStatus].
+ 	aMenu add: 'sort pages'	selector: #selectMVCItem: argument: #sortPages.
+ 	aMenu add: 'save as Custom Parts Bin' selector: #selectMVCItem: argument: #saveAsCustomPartsBin.
+ 	sel _ aMenu invokeAt: self primaryHand position in: self world.
+ 	sel ifNotNil: [self perform: sel].
+ !

Item was added:
+ ----- Method: PartsWindow>>openEditing (in category 'as yet unclassified') -----
+ openEditing
+ 	openForEditing _ true.
+ 	self color: Color green.
+ 	book pages do:
+ 		[:aPage | aPage setPartsBinStatusTo: false]!

Item was added:
+ ----- Method: PartsWindow>>saveAsCustomPartsBin (in category 'as yet unclassified') -----
+ saveAsCustomPartsBin
+ 	self inform: 'this feature is obsolete, as, indeed, is this entire tool'!

Item was added:
+ ----- Method: PartsWindow>>setLabelWidgetAllowance (in category 'label') -----
+ setLabelWidgetAllowance
+ 	^ labelWidgetAllowance _ 115!

Item was added:
+ ----- Method: PartsWindow>>sortPages (in category 'as yet unclassified') -----
+ sortPages
+ 	book sortPages!

Item was added:
+ ----- Method: PartsWindow>>toggleStatus (in category 'as yet unclassified') -----
+ toggleStatus
+ 	openForEditing _ openForEditing not.
+ 	openForEditing
+ 		ifTrue:
+ 			[self openEditing.
+ 			menuButton state: #off.
+ 			menuButton setBalloonText: 'resume being a parts bin']
+ 		ifFalse:
+ 			[self closeEditing.
+ 			menuButton state: #on.
+ 			menuButton setBalloonText: 'open for editing']!

Item was added:
+ ----- Method: PartsWindow>>wantsExpandBox (in category 'resize/collapse') -----
+ wantsExpandBox
+ 	"Answer whether I'd like an expand box"
+ 
+ 	^ false!

Item was changed:
  ----- Method: PasteUpMorph class>>additionsToViewerCategories (in category '*eToys-scripting') -----
  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."
  
  	^ # (
  
  (playfield (
  (command initiatePainting 'Initiate painting of a new object in the standard playfield.')
  (slot mouseX 'The x coordinate of the mouse pointer' Number readWrite Player getMouseX  unused unused)
  (slot mouseY 'The y coordinate of the mouse pointer' Number readWrite Player getMouseY  unused unused)
+ (slot timer 'The elapsed time in seconds' Number readWrite Player getTimer  Player setTimer:)
  (command roundUpStrays 'Bring all out-of-container subparts back into view.')
+ (slot graphic 'The graphic shown in the background of this object' Graphic readWrite Player getPasteUpGraphic Player setGraphic:)
- (slot graphic 'The graphic shown in the background of this object' Graphic readWrite Player getGraphic Player setGraphic:)
  (command unhideHiddenObjects 'Unhide all hidden objects.')))
  
  (scripting (
  (command tellAllContents: 'Send a message to all the objects inside the playfield' ScriptName)))
  
  (collections (
+ (slot cursor 'The index of the chosen element' Number readWrite Player getPasteUpCursor Player setCursorWrapped:)
- (slot cursor 'The index of the chosen element' Number readWrite Player getCursor Player setCursorWrapped:)
  (slot count 'How many elements are within me' Number readOnly Player getCount unused unused)
  (slot stringContents 'The characters of the objects inside me, laid end to end' String readOnly Player getStringContents unused unused)
  (slot playerAtCursor 'the object currently at the cursor' Player readWrite Player getValueAtCursor  unused unused)
  (slot firstElement  'The first object in my contents' Player  readWrite Player getFirstElement  Player  setFirstElement:)
  (slot numberAtCursor 'the number at the cursor' Number readWrite Player getNumberAtCursor Player setNumberAtCursor: )
  (slot graphicAtCursor 'the graphic worn by the object at the cursor' Graphic readOnly Player getGraphicAtCursor  unused unused)
  (command tellAllContents: 'Send a message to all the objects inside the playfield' ScriptName)
  (command removeAll 'Remove all elements from the playfield')
  (command shuffleContents 'Shuffle the contents of the playfield')
  (command append: 'Add the object to the end of my contents list.' Player)
  (command prepend: 'Add the object at the beginning of my contents list.' Player)
  (command includeAtCursor: 'Add the object to my contents at my current cursor position' Player)
  (command include: 'Add the object to my contents' Player)
  ))
  
+ "
  (#'stack navigation' (
  (command goToNextCardInStack 'Go to the next card')
  (command goToPreviousCardInStack  'Go to the previous card')
  (command goToFirstCardInBackground 'Go to the first card of the current background')
  (command goToFirstCardOfStack 'Go to the first card of the entire stack')
  (command goToLastCardInBackground 'Go to the last card of the current background')
  (command goToLastCardOfStack 'Go to the last card of the entire stack')
  (command deleteCard 'Delete the current card')
+ (command insertCard 'Create a new card')))"
- (command insertCard 'Create a new card')))
  
  "(viewing (
  (slot viewingNormally 'whether contents are viewed normally' Boolean readWrite Player getViewingByIcon Player setViewingByIcon: )))"
  
  (#'pen trails' (
  (command liftAllPens 'Lift the pens on all the objects in my interior.')
  (command lowerAllPens  'Lower the pens on all the objects in my interior.')
  (command trailStyleForAllPens:  'Set the trail style for pens of all objects within' TrailStyle)
+ (command clearTurtleTrails 'Clear all the pen trails in the interior.')
+ (slot batchPenTrails 'Whether pen trails should reflect small movements within the same tick or only should integrate all movement between ticks' Boolean readWrite Player getBatchPenTrails Player setBatchPenTrails:)
+ ))
+ 
+ (#sound (
+ (slot soundPitch 'pitch of sound' Number readOnly Player getPitch unused unused)
+ (slot soundLevel 'level of sound' Number readOnly Player getLevel unused unused)
+ (slot dialNumber 'dial number of sound' String readOnly Player getDialNumber unused unused)
+ (slot soundListening 'whether the stethoscope is listening' Boolean readWrite Player getListening Player setListening:)))
+ )!
- (command clearTurtleTrails 'Clear all the pen trails in the interior.'))))
- !

Item was added:
+ ----- Method: PasteUpMorph class>>additionsToViewerCategoryDisplay (in category '*Etoys-Squeakland-scripting') -----
+ additionsToViewerCategoryDisplay
+ 	"Answer display additions"
+ 
+ 	^ #(display(
+ 		(command showNavigationBar 'Show the navigation bar at the top of the screen')
+ 		(command hideNavigationBar 'Hide the navigation bar at the top of the screen')
+ 		(command useBlueprintCanvas 'Display the world as a blueprint' )
+ 		(command useNormalCanvas  'Display the world normally' Boolean)))!

Item was added:
+ ----- Method: PasteUpMorph class>>additionsToViewerCategoryPenTrails (in category '*Etoys-Squeakland-eToys-scripting') -----
+ additionsToViewerCategoryPenTrails
+ 	"Answer viewer additions for pen trails category"
+ 
+ ^ #(#'pen trails' (
+ 		(command liftAllPens 'Lift the pens on all the objects in my interior.')
+ 		(command lowerAllPens  'Lower the pens on all the objects in my interior.')
+ 		(command trailStyleForAllPens:  'Set the trail style for pens of all objects within' TrailStyle)
+ 		(command clearTurtleTrails 'Clear all the pen trails in the interior.')
+ 		(slot hasPenTrails 'Whether there are any pen trails on the playfield' Boolean readOnly Player getHasPenTrails unused unused)
+ 		(slot penTrailGraphic 'The graphic comprising the current pen trails.'   Graphic readOnly Player getPenTrailGraphic Player unused unused)))!

Item was changed:
  ----- Method: PasteUpMorph class>>additionsToViewerCategoryPreferences (in category '*eToys-scripting') -----
  additionsToViewerCategoryPreferences
  	"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."
  
  	^ #(preferences (
  			(slot useVectorVocabulary 'Whether to use the Vector vocabulary with etoy scripting in this project' Boolean readWrite Player getUseVectorVocabulary Player setUseVectorVocabulary:)
  			(slot dropProducesWatcher 'Whether a drop of a value tile, such as "car''s x", on the desktop, should produce a watcher for that value' Boolean readWrite Player getDropProducesWatcher Player setDropProducesWatcher:)
  			(slot allowEtoyUserCustomEvents 'Whether to allow "custom events" in etoys.' Boolean readWrite Player getAllowEtoyUserCustomEvents Player setAllowEtoyUserCustomEvents:)
  			(slot batchPenTrails 'Whether pen trails should reflect small movements within the same tick or only should integrate all movement between ticks' Boolean readWrite Player getBatchPenTrails Player setBatchPenTrails:)
  			"(slot eToyFriendly 'Whether various restrictions should apply in many parts of the system.  Intended to be set to true for younger users.' Boolean readWrite Player getEToyFriendly Player setEToyFriendly:)"
  			(slot fenceEnabled 'Whether an object hitting the edge of the screen should be kept "fenced in", rather than being allowed to escape and disappear' Boolean readWrite Player getFenceEnabled Player setFenceEnabled:)
  			(slot keepTickingWhilePainting 'Whether scripts should continue to run while you''re using the painting system' Boolean readWrite Player getKeepTickingWhilePainting Player setKeepTickingWhilePainting:)
  			(slot oliveHandleForScriptedObjects 'Whether the default green halo handle (at the top right of the halo) should, for scripted objects, be the olive-green handle, signifying that use will result in a sibling instance. ' Boolean readWrite Player getOliveHandleForScriptedObjects  Player setOliveHandleForScriptedObjects: )
+ 			(slot implicitSelfInTiles 'Whether tiles representing a player should be suppressed in Viewers and Scriptors belonging to that player ' Boolean readWrite Player getImplicitSelfInTiles  Player setImplicitSelfInTiles: )
  	))!

Item was added:
+ ----- Method: PasteUpMorph class>>putativeAdditionsToViewerCategoryPlayfieldOptions (in category '*Etoys-Squeakland-eToys-scripting') -----
+ putativeAdditionsToViewerCategoryPlayfieldOptions
+ 	"Answer playfield options additions.  Some of these are not yet underpinned by code in the current image; these will follow in due course."
+ 
+ 	^ #(#'playfield options' (
+ 		(command roundUpStrays 'Bring back all objects whose current coordinates keep them from being visible, so that at least a portion of each of my interior objects can be seen.')
+ 		(command makeFitContents 'Adjust my bounds so that I fit precisely around all the objects within me')
+ 		(command showAllPlayers 'Make visible the viewers for all players which have user-written scripts in this playfield.')
+ 		(command hideAllPlayers 'Make invisible the viewers for all players in this playfield. This will save space before you publish this project')
+ 		(command shuffleSubmorphs 'Rearranges my contents in random order')
+ 		(command restoreDisplay 'Redraws the screen')
+ 		(command showAllObjectNames 'show names beneath all the objects currently in my interior, except for those for which showing such names is inappropriate.')
+ 		(command hideAllObjectNames 'stop showing names beneath all the objects of my interior,  If any of them is marked to "always show name", remove that designation')))!

Item was added:
+ ----- Method: PasteUpMorph>>abandonPrivatePresenter (in category '*Etoys-Squeakland-misc') -----
+ abandonPrivatePresenter
+ 	"Abandon the receiver's private presenter."
+ 
+ 	(self isWorldMorph not and: [self hasPrivatePresenter])
+ 		ifTrue:
+ 			[presenter := nil]!

Item was added:
+ ----- Method: PasteUpMorph>>abandonReplayHandsAndHalos (in category '*Etoys-Squeakland-olpc') -----
+ abandonReplayHandsAndHalos
+ 	"Cleanup after playback."
+ 
+ 	(self submorphs select: [:m | m isKindOf: HaloMorph]) do:
+ 		[:m | m delete].
+ 	HandMorphForReplay allInstancesDo:
+ 		[:i |
+ 			i halo ifNotNilDo: [:h | h delete].
+ 			self removeHand: i]
+ "
+ ActiveWorld abandonReplayHandsAndHalos.
+ "
+ 	!

Item was added:
+ ----- Method: PasteUpMorph>>abandonReplayHandsAndHalosFor: (in category '*Etoys-Squeakland-olpc') -----
+ abandonReplayHandsAndHalosFor: anEventRecorder
+ 	"Cleanup after playback."
+ 
+ 	(self submorphs select: [:m | m isKindOf: HaloMorph]) do:
+ 		[:m | m delete].
+ 	HandMorphForReplay allInstancesDo:
+ 		[:i |
+ 			i recorder == anEventRecorder ifTrue:
+ 				[i halo ifNotNilDo: [:h | h delete].
+ 				self removeHand: i]]!

Item was added:
+ ----- Method: PasteUpMorph>>abandonUnsituatedPlayers (in category '*Etoys-Squeakland-menu') -----
+ abandonUnsituatedPlayers
+ 	"If any objects in the project have references, in player-valued variables, to other objects otherwise not present in the project, abandon them and replace former references to them by references to Dot"
+ 
+ 	| aList dot slotInfo varName ref allPlayers count |
+ 	count := 0.
+ 	allPlayers := ActiveWorld presenter reallyAllExtantPlayersNoSort.
+ 	aList := allPlayers select: [:m | m belongsToUniClass].
+ 	dot := self presenter standardPlayer.
+ 	aList do:
+ 		[:p |
+ 			p class slotInfo associationsDo:
+ 				[:assoc |
+ 					slotInfo := assoc value.
+ 					varName := assoc key.
+ 					(slotInfo type = #Player) ifTrue:
+ 						[ref := p instVarNamed: varName.
+ 						(allPlayers includes: ref) ifFalse:
+ 							[p instVarNamed: varName put: dot.
+ 							count := count + 1.
+ 							Transcript cr; show: ('Variable named "{1}" in player named "{2}" changed to point to Dot' translated format: {varName. ref externalName})]]]].
+ 	aList := nil.  "Increases chance of the next line having desired effect."
+ 	self inform: ('{1} item(s) fixed up' translated format: {count}).
+ 
+ 	WorldState addDeferredUIMessage: [Smalltalk garbageCollect]!

Item was added:
+ ----- Method: PasteUpMorph>>actionButtonsDo: (in category '*Etoys-Squeakland-e-toy support') -----
+ actionButtonsDo: aBlock
+ 	"Find all morphs with an action that fires a script.  Run the block on each one. Cases:
+ ScriptActivationButton fires a script (SimpleButtonMorph).
+ A torn off or pinned MenuItemMorph.
+ Player wearing a costume with event handler (mouseUp,mouseDown).
+ Inc/dec arrows on tiles.
+ An Open scriptor with execute (!!) button.
+ Start/Stop controls.
+ Page turn controls.
+ ProjectLink Buttons.
+ 	"
+ 	| got |
+ 	self allMorphsDo: [:mm | 
+ 		got _ false.
+ 		((mm isKindOf: SimpleButtonMorph) and: [mm actionSelector ~~ nil]) ifTrue: [
+ 			aBlock value: mm.  got _ true].
+ 		(got not and: [mm isKindOf: MenuItemMorph]) ifTrue: [ 
+ 			aBlock value: mm.  got _ true].
+ 		(got not and: [mm isKindOf: ThreePhaseButtonMorph]) ifTrue: [ 
+ 			aBlock value: mm.  got _ true].
+ 		(got not and: [mm isKindOf: TileMorph]) ifTrue: ["do not set got"
+ 			mm upArrow notNil ifTrue: [aBlock value: mm upArrow].
+ 			mm downArrow notNil ifTrue: [aBlock value: mm downArrow].
+ 			mm suffixArrow notNil ifTrue: [aBlock value: mm suffixArrow].
+ 			mm retractArrow notNil ifTrue: [aBlock value: mm retractArrow]].
+ 		(got not and: [mm isKindOf: ProjectViewMorph]) ifTrue: [ 
+ 			aBlock value: mm.  got _ true].
+ 		(got not and: [mm eventHandler ~~ nil]) ifTrue: [ 
+ 			aBlock value: mm.  got _ true].
+ 		].!

Item was added:
+ ----- Method: PasteUpMorph>>addHighlightMorph:for: (in category '*Etoys-Squeakland-highlighting') -----
+ addHighlightMorph: aMorph for: highlightee
+ 
+ 	self valueOfProperty: #hilighted ifPresentDo: [:p | p ifNotNil: [p delete]].
+ 	self setProperty: #hilighted toValue: aMorph.
+ 	highlightee ifNil: [
+ 		self addMorphFront: aMorph.
+ 	] ifNotNil: [
+ 		self addMorph: aMorph inFrontOf: highlightee.
+ 	].
+ !

Item was changed:
  ----- Method: PasteUpMorph>>addViewingItemsTo: (in category '*Etoys-viewing') -----
  addViewingItemsTo: aMenu
  	"Add viewing-related items to the given menu.  If any are added, this method is also responsible for adding a line after them"
  
+ 	true ifTrue: [^ self].  "Well, actually don't.  this was only ever just a demo."
+ 
  	#(	(viewingByIconString 			viewByIcon)
  		(viewingByNameString 			viewByName)
  		"(viewingBySizeString 			viewBySize)"
  		(viewingNonOverlappingString 	viewNonOverlapping)) do:
  			[:pair |  aMenu addUpdating: pair first target:  self action: pair second].
  	aMenu addLine
  !

Item was added:
+ ----- Method: PasteUpMorph>>allScriptEditorsInProject (in category '*Etoys-Squeakland-etoys-scripting') -----
+ allScriptEditorsInProject
+ 	"Answer a list of ScriptEditorMorphs of the project.  Note that siblings share the same ScriptEditors"
+ 
+ 	^ Array streamContents:
+ 		[:aStream |
+ 			(self presenter allExtantPlayers groupBy: [:p | p class] having: [:p | true]) do:
+ 				 [:group | aStream nextPutAll: group first allScriptEditors]]
+ 
+ 
+ "
+ ActiveWorld allScriptEditorsInProject
+ "!

Item was added:
+ ----- Method: PasteUpMorph>>allViewersInProject (in category '*Etoys-Squeakland-olpc') -----
+ allViewersInProject
+ 	"Answer a list of StandardViewers of the project.  Force instantiation ('unhibernation') of any that are currently only dummies after project-loading."
+ 
+ 	^ (self submorphs select: [:m | m isKindOf: ViewerFlapTab] thenCollect:
+ 		[:m |
+ 			m lazyUnhibernate.
+ 			m referent findA: StandardViewer]) select: [:m | m notNil]
+ 
+ "
+ ActiveWorld allViewersInProject
+ "!

Item was changed:
  ----- Method: PasteUpMorph>>attemptCleanupReporting: (in category '*Etoys-world menu') -----
  attemptCleanupReporting: whetherToReport
  	"Try to fix up some bad things that are known to occur in some etoy projects we've seen. If the whetherToReport parameter is true, an informer is presented after the cleanups"
  
+ 	| fixes faultyStatusControls |
+ 	fixes _ 0.
- 	| fixes |
- 	fixes := 0.
  	ActiveWorld ifNotNil:
  		[(ActiveWorld submorphs select:
  			[:m | (m isKindOf: ScriptEditorMorph) and: [m submorphs isEmpty]]) do:
+ 				[:m | m delete.  fixes _ fixes + 1]].
- 				[:m | m delete.  fixes := fixes + 1]].
  
  	TransformationMorph allSubInstancesDo:
  		[:m | (m player notNil and: [m renderedMorph ~~ m])
  			ifTrue:
  				[m renderedMorph visible ifFalse:
+ 					[m renderedMorph visible: true.  fixes _ fixes + 1]]].
- 					[m renderedMorph visible: true.  fixes := fixes + 1]]].
  
+ 	(Player class allSubInstances select: [:cl | cl isUniClass and: [cl instanceCount > 0]]) do:
- 	(Player class allSubInstances select: [:cl | cl isUniClass]) do:
  		[:aUniclass |
+ 			fixes _ fixes + aUniclass cleanseScripts].
- 			fixes := fixes + aUniclass cleanseScripts].
  
  	self presenter flushPlayerListCache; allExtantPlayers.
- 	whetherToReport ifTrue:
- 		[self inform: ('{1} [or more] repair(s) made' translated format: {fixes printString})]
  
+ 	faultyStatusControls := ScriptStatusControl allInstances select: [:m |m  fixUpScriptInstantiation].
+ 	fixes := fixes + faultyStatusControls size.
+ 
+ 	ScriptNameTile allInstancesDo: 
+ 		[:aTile | aTile submorphs isEmpty ifTrue: 
+ 			[aTile setLiteral: aTile literal.
+ 			fixes := fixes + 1]].
+ 
+ 	whetherToReport
+ 		ifTrue:
+ 			[self inform: ('{1} [or more] repair(s) made' translated format: {fixes printString})]
+ 		ifFalse:
+ 			[fixes > 0 ifTrue: [Transcript cr; show: fixes printString, ' repairs made to existing content.']]
+ 	
  "
  ActiveWorld attemptCleanupReporting: true.
  ActiveWorld attemptCleanupReporting: false.
  "!

Item was added:
+ ----- Method: PasteUpMorph>>buildShowClickableButton (in category '*Etoys-Squeakland-e-toy support') -----
+ buildShowClickableButton
+ 	"Return a button that momentarily highlights all clickable objects on the screen.  Showing the highlights takes a second or two, so press and be patient.
+ 
+ 	ActiveHand attachMorph: World buildShowClickableButton.
+ "
+ 
+ 	| bb |
+ 	bb _ BasicButton new label: 'Show Clickable Areas'.
+ 	bb on: #mouseDown send: #highlightActionButtonsOn to: self.
+ 	bb on: #mouseUp send: #highlightActionButtonsOff to: self.
+ 	^ bb!

Item was added:
+ ----- Method: PasteUpMorph>>buildShowSourceMenu: (in category '*Etoys-Squeakland-world menu') -----
+ buildShowSourceMenu: evt
+ 	"Build and answer the show-source menu in response to the given event."
+ 
+ 	^(TheWorldMenu new
+ 		world: self
+ 		project: (self project ifNil: [Project current])       "mvc??"
+ 		hand: evt hand) buildShowSourceMenu!

Item was added:
+ ----- Method: PasteUpMorph>>buildWorldHaloMenuForHand: (in category '*Etoys-Squeakland-menu & halo') -----
+ buildWorldHaloMenuForHand: aHand
+ 	"Build and answer a menu that will serve as the world's halo menu."
+ 
+ 	| aMenu |
+ 	aMenu _ MenuMorph new defaultTarget: self.
+ 	aMenu addStayUpItem.
+ 	self addWorldHaloMenuItemsTo: aMenu hand: aHand.
+ 	^ aMenu
+ !

Item was added:
+ ----- Method: PasteUpMorph>>collapseAllWindows (in category '*Etoys-Squeakland-world menu') -----
+ collapseAllWindows
+ 	"Collapse all non-collapsed windows"
+ 
+ 	(SystemWindow windowsIn: self satisfying: [:w | w isCollapsed not])
+ 		reverseDo: [:w | w collapseOrExpand.  self displayWorld]
+ !

Item was added:
+ ----- Method: PasteUpMorph>>collapseAllWindowsAndNonWindows (in category '*Etoys-Squeakland-world menu') -----
+ collapseAllWindowsAndNonWindows
+ 	"Collapse all objects for which it is appropriate into little window tabs or other icons, from whence they can be reopened when desired."
+ 
+ 	self submorphs do:
+ 		[:m | m collapsible ifTrue: [m collapse]]!

Item was added:
+ ----- Method: PasteUpMorph>>convertAllExtensions (in category '*Etoys-Squeakland-world state') -----
+ convertAllExtensions
+ 	"Convert all extensions to be MorphExtensionPlus's"
+ 
+ 	self allMorphsDo:
+ 		[:m | m convertExtension]
+ !

Item was added:
+ ----- Method: PasteUpMorph>>copyMorph (in category '*Etoys-Squeakland-event handling') -----
+ copyMorph
+ 	self activeHand copyMorph.
+ !

Item was added:
+ ----- Method: PasteUpMorph>>defersHaloToInterior (in category '*Etoys-Squeakland-classification') -----
+ defersHaloToInterior
+ 	"Answer whether  when a halo-click goes down over some subobject within me, I should defer to it rather than seize the halo myself."
+ 
+ 	^ true!

Item was added:
+ ----- Method: PasteUpMorph>>defersHaloToInteriorMorph: (in category '*Etoys-Squeakland-classification') -----
+ defersHaloToInteriorMorph: aMorph
+ 	"Answer whether  when a halo-click goes down over some subobject within me, I should defer to it rather than seize the halo myself."
+ 
+ 	^ true!

Item was changed:
  ----- Method: PasteUpMorph>>deleteBackgroundPainting (in category '*Etoys-playfield') -----
  deleteBackgroundPainting
  	backgroundMorph
  		ifNotNil:
  			[backgroundMorph delete.
+ 			backgroundMorph _ nil]
- 			backgroundMorph := nil]
  		ifNil:
  			[self inform: 'There is presently no
  background painting
+ to delete.' translated]!
- to delete.']!

Item was added:
+ ----- Method: PasteUpMorph>>deleteListeners (in category '*Etoys-Squeakland-misc') -----
+ deleteListeners
+ 
+ 	(submorphs select: [:e | (e isKindOf: SugarListenerMorph) and: [e position < (0 at 0)]]) do: [:e | e delete].
+ !

Item was added:
+ ----- Method: PasteUpMorph>>expandAllCollapsedObjects (in category '*Etoys-Squeakland-world menu') -----
+ expandAllCollapsedObjects
+ 	"Expand all collapsed objects"
+ 
+ 	| anImageMorph |
+ 	(SystemWindow windowsIn: self satisfying: [:w | w isCollapsed])
+ 		reverseDo: [:w | w collapseOrExpand.  self displayWorld].
+ 	submorphs do:
+ 		[:aMorph |
+ 			((aMorph submorphs size > 0) and:
+ 				[(anImageMorph := aMorph submorphs first) isKindOf: ImageMorph] and:
+ 				[anImageMorph hasProperty: #uncollapsedMorph]) ifTrue:
+ 					[anImageMorph uncollapseSketch]]!

Item was added:
+ ----- Method: PasteUpMorph>>extantGlobalFlapTabs (in category '*Etoys-Squeakland-flaps') -----
+ extantGlobalFlapTabs
+ 	"Answer a list of global flap tabs in the  receiver."
+ 
+ 	| globalList |
+ 	globalList _ Flaps globalFlapTabsIfAny.
+ 	^ submorphs select: [:m | (m isKindOf: FlapTab) and: [globalList includes: m]] 
+ 
+ "
+ ActiveWorld extantGlobalFlapTabs 
+ "!

Item was added:
+ ----- Method: PasteUpMorph>>hasPenTrails (in category '*Etoys-Squeakland-pen') -----
+ hasPenTrails
+ 	"Answer whether the receiver has any pen trails."
+ 
+ 	^ turtleTrailsForm notNil!

Item was added:
+ ----- Method: PasteUpMorph>>hasPrivatePresenter (in category '*Etoys-Squeakland-misc') -----
+ hasPrivatePresenter
+ 	"Answer whether the receiver currently bears a private presenter."
+ 
+ 	^ self presenter associatedMorph == self!

Item was changed:
  ----- Method: PasteUpMorph>>hideAllPlayers (in category '*Etoys-world menu') -----
  hideAllPlayers
+ 	"Remove all Viewers belonging to scripted players associated with the receiver or any of its subjects from the screen."
  
  	| a |
+ 	a _ OrderedCollection new.
- 	a := OrderedCollection new.
  	self allMorphsDo: [ :x | 
+ 		(ActiveWorld presenter currentlyViewing: x player) ifTrue:
+ 			[a add: x player viewerFlapTab]].
+ 
+ 	a do: [ :each | each dismissViaHalo].
- 		(x isKindOf: ViewerFlapTab) ifTrue: [a add: x]
- 	].
- 	a do: [ :each | each delete].
  !

Item was added:
+ ----- Method: PasteUpMorph>>highlightActionButtons: (in category '*Etoys-Squeakland-e-toy support') -----
+ highlightActionButtons: onOff
+ 	"Put a thin red outline around all morphs that have a click action.  onOff = true to turn on, false to turn off, and nil to flash for 3 seconds.
+ Would like the highlight to be outside the object, but not change its layout (i.e. in a scriptor). Unfortunately, outerBounds is used both for this mouse action indicator, and for cell layout!!"
+ 
+ 	"	World highlightActionButtons: nil	"
+ 
+ 	onOff == false ifFalse: ["true or nil"
+ 		Cursor wait showWhile: [
+ 			self actionButtonsDo: [:mm | 
+ 				mm	addMouseActionIndicatorsWidth: 2 color: (Color red)].
+ 			self displayWorldSafely]].
+ 	onOff ifNil: [
+ 		(Delay forSeconds: 3) wait].
+ 	onOff == true ifFalse: ["false or nil"
+ 		self actionButtonsDo: [:mm | mm	deleteAnyMouseActionIndicators]].!

Item was added:
+ ----- Method: PasteUpMorph>>highlightActionButtonsOff (in category '*Etoys-Squeakland-e-toy support') -----
+ highlightActionButtonsOff
+ 	"Toggle showing highlights around clickable things.  Conform to the on:send:to: convention"
+ 
+ 	^ self highlightActionButtons: false!

Item was added:
+ ----- Method: PasteUpMorph>>highlightActionButtonsOn (in category '*Etoys-Squeakland-e-toy support') -----
+ highlightActionButtonsOn
+ 	"Toggle showing highlights around clickable things.  Conform to the on:send:to: convention"
+ 
+ 	^ self highlightActionButtons: true!

Item was added:
+ ----- Method: PasteUpMorph>>isKedamaPresent (in category '*Etoys-Squeakland-e-toy support') -----
+ isKedamaPresent
+ 	"Answer whether there is a KedamaMorph present anywhere in the world."
+ 
+ 	^ (self findDeeplyA: KedamaMorph) notNil!

Item was added:
+ ----- Method: PasteUpMorph>>makeReference:to: (in category '*Etoys-support') -----
+ makeReference: aName to: anObject
+ 
+ 	| oldKey oldAssoc |
+ 	self referencePool at: aName put: anObject.
+ 
+ 	oldKey _ References keyAtValue: anObject ifAbsent: [].
+ 	oldKey ifNotNil: [
+ 		oldAssoc _ References associationAt: oldKey.
+ 		References removeKey: oldKey.
+ 		oldAssoc becomeForward: (self referencePool associationAt: aName).
+ 	].
+ 
+ !

Item was added:
+ ----- Method: PasteUpMorph>>openAppropriatePropertySheet (in category '*Etoys-Squeakland-display') -----
+ openAppropriatePropertySheet
+ 	(self fillStyle isBitmapFill and:[ (self valueOfProperty:#graphPaperParameters ) notNil])
+ 		ifTrue:[self putUpGraphPaperPanel]
+ 		ifFalse:[self openAPropertySheet]!

Item was added:
+ ----- Method: PasteUpMorph>>pasteMorph (in category '*Etoys-Squeakland-event handling') -----
+ pasteMorph
+ 	self activeHand pasteMorph.
+ !

Item was changed:
  ----- Method: PasteUpMorph>>playfieldOptionsMenu (in category '*Etoys-playfield') -----
  playfieldOptionsMenu
  	"Answer an auxiliary menu with options specific to playfields -- too many to be housed in the main menu"
  
  	| aMenu isWorld |
+ 	isWorld _ self isWorldMorph.
+ 	aMenu _ MenuMorph new defaultTarget: self.
- 	isWorld := self isWorldMorph.
- 	aMenu := MenuMorph new defaultTarget: self.
  	aMenu addStayUpItem.
- 	aMenu add: 'save on file...' translated action: #saveOnFile.
- 	Preferences eToyFriendly ifFalse: [
- 		aMenu add: 'save as SqueakPage at url...' translated action: #saveOnURL.
- 		aMenu add: 'update all from resources' translated action: #updateAllFromResources].
  
+ 	#(
+ 	(autoLineLayoutString	toggleAutoLineLayout
+ 			'whether submorphs should automatically be laid out in lines')
+ 	(autoExpansionString	toggleAutomaticPhraseExpansion
+ 			'whether tile phrases, dropped on me, should automatically sprout Scriptors around them')
- 	aMenu add: 'round up strays' translated action: #roundUpStrays.
- 	aMenu balloonTextForLastItem:  'Bring back all objects whose current coordinates keep them from being visible, so that at least a portion of each of my interior objects can be seen.' translated.
- 	aMenu add: 'show all players' translated action: #showAllPlayers.
- 	aMenu balloonTextForLastItem:  'Make visible the viewers for all players which have user-written scripts in this playfield.' translated.
- 	aMenu add: 'hide all players' translated action: #hideAllPlayers.
- 	aMenu balloonTextForLastItem:  'Make invisible the viewers for all players in this playfield. This will save space before you publish this project' translated.
  
+ 	(autoViewingString  toggleAutomaticViewing
+ 		'governs whether, when an object is touched inside me, a viewer should automatically be launched for it')
  
+ 	(behaveLikeAHolderString	toggleBehaveLikeAHolder
+ 			'whether auto-line-layout, resize-to-fit, and indicate-cursor should be set to true; useful for animation control, etc.')
- 	aMenu addLine.
- 	aMenu add: 'shuffle contents' translated action: #shuffleSubmorphs.
- 	aMenu balloonTextForLastItem: 'Rearranges my contents in random order' translated.
- 	self griddingOn
- 		ifTrue: [aMenu add: 'turn gridding off' translated action: #griddingOnOff.
- 				aMenu add: (self gridVisible ifTrue: ['hide'] ifFalse: ['show']) translated, ' grid' translated
- 						action: #gridVisibleOnOff.
- 				aMenu add: 'set grid spacing...' translated action: #setGridSpec]
- 		ifFalse: [aMenu add: 'turn gridding on' translated action: #griddingOnOff].
- 	aMenu addLine.
  
+ 	(fenceEnabledString	toggleFenceEnabled
+ 			'whether moving objects should stop at the edge of their container')
+ 
+ 	(gridVisibleString		gridVisibleOnOff
+ 			'whether the grid should be shown when gridding is on')
+ 	(indicateCursorString	toggleIndicateCursor
- 	#(	(autoLineLayoutString	toggleAutoLineLayout
- 			'whether submorphs should automatically be laid out in lines')
- 		(indicateCursorString	toggleIndicateCursor
  			'whether the "current" submorph should be indicated with a dark black border')
+ 	(mouseOverHalosString	toggleMouseOverHalos
- 		(isPartsBinString		toggleIsPartsBin
- 			'whether dragging an object from the interior should produce a COPY of the object')
- 		(isOpenForDragNDropString	toggleDragNDrop
- 			'whether objects can be dropped into and dragged out of me')
- 		(mouseOverHalosString	toggleMouseOverHalos
  			'whether objects should put up halos when the mouse is over them')
+ 	(originAtCenterString		toggleOriginAtCenter
- 		(autoExpansionString	toggleAutomaticPhraseExpansion
- 			'whether tile phrases, dropped on me, should automatically sprout Scriptors around them')
- 		(originAtCenterString	toggleOriginAtCenter
  			'whether the cartesian origin of the playfield should be at its lower-left corner or at the center of the playfield')
+ 	(isPartsBinString		toggleIsPartsBin
+ 			'whether dragging an object from the interior should produce a COPY of the object')
+ 	(resizeToFitString		toggleResizeToFit
+ 			'whether I should automatically strive exactly to fit my contents')
+ 	(showThumbnailString	toggleAlwaysShowThumbnail
- 		(showThumbnailString	toggleAlwaysShowThumbnail
  			'whether large objects should be represented by thumbnail miniatures of themselves')
+ 	(griddingString			griddingOnOff
+ 			'whether gridding should be used in my interior')
- 		(fenceEnabledString	toggleFenceEnabled
- 			'whether moving objects should stop at the edge of their container')
- 		(batchPenTrailsString	toggleBatchPenTrails 
- 			'if true, detailed movement of pens between display updates is ignored.  Thus multiple line segments drawn within a script may not be seen individually.')
  
+ 	) translatedNoop do:
- 	) do:
- 
  			[:triplet |
+ 				(isWorld and: [#(toggleAutoLineLayout toggleBehaveLikeAHolder toggleIndicateCursor toggleIsPartsBin toggleAlwaysShowThumbnail toggleResizeToFit ) includes: triplet second]) ifFalse:
- 				(isWorld and: [#(toggleAutoLineLayout toggleIndicateCursor toggleIsPartsBin toggleAlwaysShowThumbnail) includes: triplet second]) ifFalse:
  					[aMenu addUpdating: triplet first action: triplet second.
+ 					aMenu balloonTextForLastItem: triplet third translated]].
- 					aMenu balloonTextForLastItem: triplet third translated]]. 
  
+ 	aMenu addLine.
+ 	aMenu add: 'round up strays' translated action: #roundUpStrays.
+ 	aMenu balloonTextForLastItem:  'Bring back all objects whose current coordinates keep them from being visible, so that at least a portion of each of my interior objects can be seen.' translated.
- 	aMenu addUpdating: #autoViewingString action: #toggleAutomaticViewing.
- 	aMenu balloonTextForLastItem:  'governs whether, when an object is touched inside me, a viewer should automatically be launched for it.' translated.
  
+ 	isWorld ifFalse:
+ 		[aMenu add: 'shuffle contents' translated action: #shuffleSubmorphs.
+ 		aMenu balloonTextForLastItem: 'Rearranges my contents in random order' translated].
+ 	aMenu add: 'set grid spacing...' translated action: #setGridSpec.
+ 	aMenu balloonTextForLastItem: 'Set the spacing to be used when gridding is on' translated.
- 	((isWorld not or: [self backgroundSketch notNil]) or: [presenter isNil])
- 		ifTrue:
- 			[aMenu addLine].
  
  	isWorld ifFalse:
  		[aMenu add: 'set thumbnail height...' translated action: #setThumbnailHeight.
+ 		aMenu balloonTextForLastItem: 'if currently showing thumbnails governs the standard height for them' translated].
- 		aMenu balloonTextForLastItem: 'if currently showing thumbnails governs the standard height for them' translated.
- 		aMenu add: 'behave like a Holder' translated action: #becomeLikeAHolder.
- 		aMenu balloonTextForLastItem: 'Set properties to make this object nicely set up to hold frames of a scripted animation.' translated].
  
  	self backgroundSketch ifNotNil:
  		[aMenu add: 'delete background painting' translated action: #deleteBackgroundPainting.
  		aMenu balloonTextForLastItem: 'delete the graphic that forms the background for this me.' translated].
  	presenter ifNil:
  		[aMenu add: 'make detachable' translated action: #makeDetachable.
  		aMenu balloonTextForLastItem: 'Allow this area to be separately governed by its own controls.' translated].
  
  	aMenu addLine.
  	aMenu add: 'use standard texture' translated action: #setStandardTexture.
  	aMenu balloonTextForLastItem: 'use a pale yellow-and-blue background texture here.' translated.
  	aMenu add: 'make graph paper...' translated action: #makeGraphPaper.
  	aMenu balloonTextForLastItem: 'Design your own graph paper and use it as the background texture here.' translated.
+ 	aMenu addLine.
- 	aMenu addTitle: 'playfield options...' translated.
  
+ 	aMenu add: 'show viewers of all players' translated action: #showAllPlayers.
+ 	aMenu balloonTextForLastItem:  'Make viewers for all players which have user-written scripts in this playfield.' translated.
+ 	aMenu add: 'remove viewers of all players' translated action: #hideAllPlayers.
+ 	aMenu balloonTextForLastItem:  'Remove the viewers for all players in this playfield. This will save space before you publish this project' translated.
+ 
+ 	aMenu addTitle: 'playfield options' translated.
+ 
  	^ aMenu
  !

Item was added:
+ ----- Method: PasteUpMorph>>presentDesktopColorMenu (in category '*Etoys-Squeakland-menus') -----
+ presentDesktopColorMenu
+ 	"Present the menu that governs the fill style of the squeak desktop."
+ 
+ 	| aMenu |
+ 	aMenu _ MenuMorph new defaultTarget: self.
+ 	aMenu title: 'desktop color' translated.
+ 	self fillStyle addFillStyleMenuItems: aMenu hand: ActiveHand from: self.
+ 	aMenu addLine.
+ 	aMenu add: 'solid fill' translated action: #useSolidFill.
+ 	aMenu add: 'gradient fill' translated action: #useGradientFill.
+ 	aMenu add: 'bitmap fill' translated action: #useBitmapFill.
+ 	aMenu add: 'default fill' translated action: #useDefaultFill.
+ 	aMenu popUpInWorld !

Item was changed:
  ----- Method: PasteUpMorph>>presentViewMenu (in category '*Etoys-viewing') -----
  presentViewMenu
  	"Answer an auxiliary menu with options specific to viewing playfields -- this is put up from the provisional 'view' halo handle, on pasteup morphs only."
  
  	| aMenu isWorld |
+ 	isWorld _ self isWorldMorph.
+ 	aMenu _ MenuMorph new defaultTarget: self.
- 	isWorld := self isWorldMorph.
- 	aMenu := MenuMorph new defaultTarget: self.
  	aMenu addStayUpItem.
  	self addViewingItemsTo: aMenu.
  
  	#(	"(autoLineLayoutString	toggleAutoLineLayout
  			'whether submorphs should automatically be laid out in lines')"
  		(indicateCursorString	toggleIndicateCursor
  			'whether the "current" submorph should be indicated with a dark black border')
  		(resizeToFitString		toggleResizeToFit
  			'whether I should automatically strive exactly to fit my contents')
  		(behaveLikeAHolderString	toggleBehaveLikeAHolder
  			'whether auto-line-layout, resize-to-fit, and indicate-cursor should be set to true; useful for animation control, etc.')
  		(isPartsBinString		toggleIsPartsBin
  			'whether dragging an object from the interior should produce a COPY of the object')
  		(isOpenForDragNDropString	toggleDragNDrop
  			'whether objects can be dropped into and dragged out of me')
  		(mouseOverHalosString	toggleMouseOverHalos
  			'whether objects should put up halos when the mouse is over them')
  		(autoExpansionString	toggleAutomaticPhraseExpansion
  			'whether tile phrases, dropped on me, should automatically sprout Scriptors around them')
  		(originAtCenterString	toggleOriginAtCenter
  			'whether the cartesian origin of the playfield should be at its lower-left corner or at the center of the playfield')
  		(showThumbnailString	toggleAlwaysShowThumbnail
  			'whether large objects should be represented by thumbnail miniatures of themselves')
  		(fenceEnabledString	toggleFenceEnabled
  			'whether moving objects should stop at the edge of their container')
  		(autoViewingString		toggleAutomaticViewing
  			'governs whether, when an object is touched inside me, a viewer should automatically be launched for it.')
  		(griddingString			griddingOnOff
  			'whether gridding should be used in my interior')
  		(gridVisibleString		gridVisibleOnOff
  			'whether the grid should be shown when gridding is on')
  
  
  	) do:
  
  			[:triplet |
  				(isWorld and: [#(toggleAutoLineLayout toggleIndicateCursor toggleIsPartsBin toggleAlwaysShowThumbnail toggleAutomaticViewing ) includes: triplet second]) ifFalse:
  					[aMenu addUpdating: triplet first action: triplet second.
  					aMenu balloonTextForLastItem: triplet third translated]]. 
  
  	aMenu addLine.
  	aMenu add: 'round up strays' translated action: #roundUpStrays.
  	aMenu balloonTextForLastItem:  'Bring back all objects whose current coordinates keep them from being visible, so that at least a portion of each of my interior objects can be seen.' translated.
+ 	aMenu add: 'gallery of players' translated target: self action: #galleryOfPlayers.
+ 	aMenu balloonTextForLastItem:  'A tool that lets you find out about all the players used in this project' translated.
+ 
  	aMenu add: 'shuffle contents' translated action: #shuffleSubmorphs.
  	aMenu balloonTextForLastItem: 'Rearranges my contents in random order' translated.
  	aMenu add: 'set grid spacing...' translated action: #setGridSpec.
  	aMenu balloonTextForLastItem: 'Set the spacing to be used when gridding is on' translated.
  
  	isWorld ifFalse:
  		[aMenu add: 'set thumbnail height...' translated action: #setThumbnailHeight.
  		aMenu balloonTextForLastItem: 'if currently showing thumbnails governs the standard height for them' translated].
  
  	self backgroundSketch ifNotNil:
  		[aMenu add: 'delete background painting' translated action: #deleteBackgroundPainting.
  		aMenu balloonTextForLastItem: 'delete the graphic that forms the background for this me.' translated].
  	aMenu addLine.
  	self addPenTrailsMenuItemsTo: aMenu.
  	aMenu addLine.
  	aMenu add: 'use standard texture' translated action: #setStandardTexture.
  	aMenu balloonTextForLastItem: 'use a pale yellow-and-blue background texture here.' translated.
  	aMenu add: 'make graph paper...' translated action: #makeGraphPaper.
  	aMenu balloonTextForLastItem: 'Design your own graph paper and use it as the background texture here.' translated.
  	aMenu addTitle: ('viewing options for "{1}"' translated format: {self externalName}).
  
  	aMenu popUpForHand: self activeHand in: self world
  !

Item was changed:
  ----- Method: PasteUpMorph>>printVocabularySummary (in category '*Etoys-playfield') -----
  printVocabularySummary
  	"Put up a window with summaries of all Morph vocabularies."
  
  	
  	(StringHolder new contents: EToyVocabulary vocabularySummary) 
+ 	openLabel: 'EToy Vocabulary' translated
- 	openLabel: 'EToy Vocabulary' 
  
  	"self currentWorld printVocabularySummary"!

Item was added:
+ ----- Method: PasteUpMorph>>putUpShowSourceMenu:title: (in category '*Etoys-Squeakland-world menu') -----
+ putUpShowSourceMenu: evt title: aTitle
+ 	"Put up a menu in response to the show-source button being hit"
+ 
+ 	| menu |
+ 	self bringTopmostsToFront.
+ 	"put up the show-source menu"
+ 	menu _ (TheWorldMenu new adaptToWorld: ActiveWorld) buildShowSourceMenu.
+ 	menu addTitle: aTitle.
+ 	menu popUpEvent: evt in: self.
+ 	^ menu!

Item was added:
+ ----- Method: PasteUpMorph>>quitSqueak (in category '*Etoys-Squeakland-MorphicExtras-Navigators') -----
+ quitSqueak
+ 	"Obtain a confirmation from the user, and if the answer is true, quite Squeak summarily.  If running under Sugar, quit wiithout the confirmation dialog.  Not current in the flow-of-control, but useful to call if one were to implement a ctl-q shortcut for quitting (currently done by Sugar if running under sugar.)"
+ 
+ 	SugarLauncher isRunningInSugar
+ 		ifTrue: [^ SugarLauncher current quit].
+ 
+ 	(self confirm: 'Are you sure you want to quit Etoys?' translated) ifFalse: [^ self].
+ 	
+ 	SmalltalkImage current snapshot: false andQuit: true
+ !

Item was added:
+ ----- Method: PasteUpMorph>>removeHighlightFeedback (in category '*Etoys-Squeakland-highlighting') -----
+ removeHighlightFeedback
+ 
+ 	| prop |
+ 	prop _ self valueOfProperty: #hilighted ifAbsent: [^ self].
+ 	prop delete.
+ 	self setProperty: #hilighted toValue: nil.
+ !

Item was added:
+ ----- Method: PasteUpMorph>>showSourceKeyHit (in category '*Etoys-Squeakland-world menu') -----
+ showSourceKeyHit
+ 	"The user hit the 'show source' key on the XO.  Our current take on this is simply to put up the world menu..."
+ 
+ 	^ self putUpShowSourceMenu: ActiveEvent title: 'etoys source' translated!

Item was added:
+ ----- Method: PasteUpMorph>>sugarAllowance (in category '*Etoys-Squeakland-world state') -----
+ sugarAllowance
+ 	"Answer how much to allow at the top of the world for the sugar nav bar."
+ 
+ 	| nav |
+ 	^ SugarNavigatorBar showSugarNavigator
+ 		ifFalse:
+ 			[0]
+ 		ifTrue:
+ 			[nav := self findA: SugarNavTab.
+ 			^ nav
+ 				ifNotNil:
+ 					[nav height]
+ 				ifNil:
+ 					[self valueOfProperty: #sugarNavHeight ifAbsent: [75]]]!

Item was added:
+ ----- Method: PasteUpMorph>>toggleFullScreen (in category '*Etoys-Squeakland-menu') -----
+ toggleFullScreen
+ 	"Toggle the full-screenness; we simply flip the global flaps-suppressed setting."
+ 
+ 	| tab |
+ 	(SugarNavigatorBar showHideButton and:
+ 			[(tab := self findA: SugarNavTab) notNil])
+ 		ifTrue:
+ 			[tab collapsedMode
+ 				ifTrue:
+ 					[tab showNavBar]
+ 				ifFalse:
+ 					[tab hideNavBar]]
+ 		ifFalse:
+ 			[CurrentProjectRefactoring currentToggleFlapsSuppressed]!

Item was added:
+ ----- Method: PasteUpMorph>>turtleTrailsForm (in category '*Etoys-Squeakland-pen') -----
+ turtleTrailsForm
+ 	"Answer the receiver's turtleTrailsForm; often nil."
+ 
+ 	^ turtleTrailsForm!

Item was added:
+ ----- Method: PasteUpMorph>>uniqueNameForReferenceFor: (in category '*Etoys-support') -----
+ uniqueNameForReferenceFor: aPlayer
+ 
+ 	| aName nameSym stem knownClassVars |
+ 	(aName _ self uniqueNameForReferenceOrNilFor: aPlayer) ifNotNil: [^ aName].
+ 	(stem _ aPlayer knownName) ifNil:
+ 		[stem _ aPlayer defaultNameStemForInstances asString].
+ 	stem _ stem select: [:ch | ch isLetter or: [ch isDigit]].
+ 	stem size == 0 ifTrue: [stem _ 'A'].
+ 	stem first isLetter ifFalse:
+ 		[stem _ 'A', stem].
+ 	stem _ stem capitalized.
+ 	knownClassVars _ ScriptingSystem allKnownClassVariableNames.
+ 	aName _ Utilities keyLike: stem satisfying:
+ 		[:jinaLake |
+ 			nameSym _ jinaLake asSymbol.
+ 			 ((self referencePool includesKey: nameSym) not and:
+ 				[(Smalltalk includesKey: nameSym) not]) and:
+ 						[(knownClassVars includes: nameSym) not]].
+ 
+ 	self makeReference: aName asSymbol to: aPlayer.
+ 	^ aName!

Item was added:
+ ----- Method: PasteUpMorph>>uniqueNameForReferenceOrNilFor: (in category '*Etoys-support') -----
+ uniqueNameForReferenceOrNilFor: anObject
+ 
+ 	^ self referencePool keyAtValue: anObject ifAbsent: [nil].
+ !

Item was changed:
  ----- Method: PasteUpMorph>>updateSubmorphThumbnails (in category '*Etoys-viewing') -----
  updateSubmorphThumbnails
+ 	| thumbsUp itsThumbnail heightForThumbnails maxHeightToAvoidThumbnailing maxWidthForThumbnails |
+ 	thumbsUp _ self alwaysShowThumbnail.
+ 	heightForThumbnails _ self heightForThumbnails.
+ 	maxHeightToAvoidThumbnailing _ self maxHeightToAvoidThumbnailing.
+ 	maxWidthForThumbnails _ self maximumThumbnailWidth.
- 	| thumbsUp heightForThumbnails maxHeightToAvoidThumbnailing maxWidthForThumbnails |
- 	thumbsUp := self alwaysShowThumbnail.
- 	heightForThumbnails := self heightForThumbnails.
- 	maxHeightToAvoidThumbnailing := self maxHeightToAvoidThumbnailing.
- 	maxWidthForThumbnails := self maximumThumbnailWidth.
  	self submorphs do:
+ 		[:aMorph | thumbsUp
- 		[:aMorph | | itsThumbnail |
- 		thumbsUp
  			ifTrue:
+ 				[itsThumbnail _ aMorph representativeNoTallerThan: maxHeightToAvoidThumbnailing norWiderThan: maxWidthForThumbnails thumbnailHeight: heightForThumbnails.
- 				[itsThumbnail := aMorph representativeNoTallerThan: maxHeightToAvoidThumbnailing norWiderThan: maxWidthForThumbnails thumbnailHeight: heightForThumbnails.
  				(aMorph == itsThumbnail)
  					ifFalse:
  						[self replaceSubmorph: aMorph by: itsThumbnail]]
  			ifFalse:
  				[(aMorph isKindOf: MorphThumbnail)
  					ifTrue:
+ 						[self replaceSubmorph: aMorph by: aMorph morphRepresented]]].
+ 
+ 	self invalidRect: self bounds!
- 						[self replaceSubmorph: aMorph by: aMorph morphRepresented]]]!

Item was changed:
  ----- Method: PasteUpMorph>>viewerFlapTabFor: (in category '*Etoys-playfield') -----
  viewerFlapTabFor: anObject
  	"Open up a Viewer on aMorph in its own flap, creating it if necessary"
  
  	| bottomMost aPlayer aFlapTab tempFlapTab |
+ 	bottomMost _ self top + 75.
+ 	aPlayer _ anObject isMorph ifTrue: [anObject assuredPlayer] ifFalse: [anObject objectRepresented].
- 	bottomMost := self top.
- 	aPlayer := anObject isMorph ifTrue: [anObject assuredPlayer] ifFalse: [anObject objectRepresented].
  	self flapTabs do:
  		[:aTab | ((aTab isKindOf: ViewerFlapTab) or: [aTab hasProperty: #paintingFlap])
  			ifTrue:
+ 				[bottomMost _ aTab bottom max: bottomMost.
- 				[bottomMost := aTab bottom max: bottomMost.
  				((aTab isKindOf: ViewerFlapTab) and: [aTab scriptedPlayer == aPlayer])
  					ifTrue:
  						[^ aTab]]].
  	"Not found; make a new one"
+ 	tempFlapTab _ Flaps newFlapTitled: anObject nameForViewer onEdge: #right inPasteUp: self.
- 	tempFlapTab := Flaps newFlapTitled: anObject nameForViewer onEdge: #right inPasteUp: self.
  	tempFlapTab arrangeToPopOutOnDragOver: false;
  		arrangeToPopOutOnMouseOver: false. 
  	"For some reason those event handlers were causing trouble, as reported by ar 11/22/2001, after di's flapsOnBottom update."
+ 	aFlapTab _ tempFlapTab as: ViewerFlapTab.
- 	aFlapTab := tempFlapTab as: ViewerFlapTab.
  
  	aFlapTab initializeFor: aPlayer topAt: bottomMost + 2.
  	aFlapTab referent color: (Color green muchLighter alpha: 0.5).
  	aFlapTab referent borderWidth: 0.
  	aFlapTab referent setProperty: #automaticPhraseExpansion toValue: true.
  	Preferences compactViewerFlaps 
  		ifTrue:	[aFlapTab makeFlapCompact: true].
  	self addMorphFront: aFlapTab.
  	aFlapTab adaptToWorld: self.
  	aFlapTab setProperty: #isEToysFlap toValue: true.
  	^ aFlapTab!

Item was added:
+ ----- Method: PasteUpMorph>>wantsGraphPaperAlternative (in category '*Etoys-Squeakland-testing') -----
+ wantsGraphPaperAlternative
+ 	"Answer whether the receiver woud be willing to adopt graph paper as a fill style."
+ 
+ 	^ true!

Item was added:
+ ----- Method: PasteUpMorph>>wantsTransfarHaloFromClick (in category '*Etoys-Squeakland-halos and balloon help') -----
+ wantsTransfarHaloFromClick
+ 	"Answer whether I would feel strongly about acquiring the halo for a click on a subobject within me."
+ 
+ 	^ (owner notNil and: [owner encouragesHaloTransferToEnclosedPasteUpMorph])!

Item was added:
+ ----- Method: Pen>>gotoBack: (in category '*Etoys-Squeakland-operations') -----
+ gotoBack: aPoint 
+ 	"Draw a line on back of the current drawing"
+ 	| region backupForm |
+ 	region := self regionFor: aPoint.
+ 	backupForm := destForm copy: region.
+ 	destForm fill: region fillColor: Color transparent.
+ 	self goto: aPoint.
+ 	destForm
+ 		copy: region
+ 		from: 0 @ 0
+ 		in: backupForm
+ 		rule: Form paint!

Item was added:
+ ----- Method: Pen>>regionFor: (in category '*Etoys-Squeakland-operations') -----
+ regionFor: aPoint 
+ 	"Answer drawn area for #goto:"
+ 	| brushRect startRect endRect region |
+ 	brushRect := sourceForm relativeRectangle.
+ 	startRect := brushRect translateBy: self location.
+ 	endRect := brushRect translateBy: aPoint.
+ 	region := startRect merge: endRect.
+ 	^ region!

Item was added:
+ PhraseTileMorph subclass: #PhraseTileForTest
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Scripting Tiles'!

Item was added:
+ ----- Method: PhraseTileForTest>>addCommandFeedback: (in category 'as yet unclassified') -----
+ addCommandFeedback: evt
+ 	"Add screen feedback showing what would be torn off in a drag"
+ 
+ 	| aMorph |
+ 	(self owner owner isMemberOf: PhraseTileMorph) ifTrue: [self owner owner addCommandFeedback: evt. ^ self].
+ 	aMorph _ RectangleMorph new bounds: ((self topLeft - (2 at 1)) corner: (self bottomRight) + (2 at 1)).
+ 	aMorph beTransparent; borderWidth: 2; borderColor: ScriptingSystem commandFeedback; lock.
+ 	ActiveWorld addHighlightMorph: aMorph for: self outmostScriptEditor!

Item was added:
+ ----- Method: PhraseTileForTest>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 
+ 	super initialize.
+ 	self color: Color orange muchLighter.
+ 	self
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #shrinkWrap;
+ 		borderWidth: 1;
+ 		borderColor: ScriptingSystem standardTileBorderColor.
+ 	self setupCostume.
+ !

Item was added:
+ ----- Method: PhraseTileForTest>>mouseDown: (in category 'mouse') -----
+ mouseDown: evt 
+ 	"Handle a mouse-down on the receiver"
+ 
+ 	| guyToTake catViewer |
+ 	guyToTake _ CompoundTileMorph new.
+ 	guyToTake setNamePropertyTo: 'TestTile' translated.
+ 	guyToTake position: evt position + (-25 at 8).
+ 
+ 	guyToTake formerPosition: ActiveHand position.
+ 	"self startSteppingSelector: #trackDropZones."
+ 	(catViewer := self ownerThatIsA: CategoryViewer) ifNotNil:
+ 		[guyToTake setProperty: #newPermanentPlayer toValue: catViewer scriptedPlayer.
+ 		guyToTake setProperty: #newPermanentScript toValue: true].
+ 	guyToTake justGrabbedFromViewer: true.
+ 
+ 	^ evt hand grabMorph: guyToTake
+ !

Item was added:
+ ----- Method: PhraseTileForTest>>setupCostume (in category 'as yet unclassified') -----
+ setupCostume
+ 
+ 	| stringMorph |
+ 	stringMorph _ StringMorph new contents: 'Test' translated.
+ 	stringMorph name: 'Test' translated.
+ 	stringMorph font: Preferences standardEToysFont.
+ 	self addMorphBack: stringMorph.
+ 	self addMorphBack: (Morph new color: color;
+ 			 extent: 15 @ 5).
+ 
+ 	stringMorph _ StringMorph new contents: 'Yes' translated.
+ 	stringMorph name: 'Yes' translated.
+ 	stringMorph font: Preferences standardEToysFont.
+ 	self addMorphBack: stringMorph.
+ 	self addMorphBack: (Morph new color: color;
+ 			 extent: 15 @ 5).
+ 
+ 	stringMorph _ StringMorph new contents: 'No' translated.
+ 	stringMorph name: 'No' translated.
+ 	stringMorph font: Preferences standardEToysFont.
+ 	self addMorphBack: stringMorph.
+ 	self addMorphBack: (Morph new color: color;
+ 			 extent: 15 @ 5).
+ !

Item was added:
+ PhraseTileMorph subclass: #PhraseTileForTimesRepeat
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Scripting Tiles'!
+ 
+ !PhraseTileForTimesRepeat commentStamp: 'sw 12/19/2006 18:15' prior: 0!
+ A place-holder for a Times-Repeat complex of etoy tiles.  Used in a Viewer; when the user drags one of these, he ends up with a fully-instantiated Times/Repeat complex of tiles in his hand; if he drops such a group on the desktop, a new script is created for the object associated with the Viewer in question, with the Times/Repeat as its initial contents.!

Item was added:
+ ----- Method: PhraseTileForTimesRepeat>>addCommandFeedback: (in category 'hilighting') -----
+ addCommandFeedback: evt
+ 	"Add screen feedback showing what would be torn off in a drag"
+ 
+ 	| aMorph |
+ 	
+ 	(self owner owner isMemberOf: PhraseTileMorph) ifTrue: [self owner owner addCommandFeedback: evt. ^ self].
+ 	aMorph _ RectangleMorph new bounds: ((self topLeft - (2 at 1)) corner: (self bottomRight) + (2 at 1)).
+ 	aMorph beTransparent; borderWidth: 2; borderColor: ScriptingSystem commandFeedback; lock.
+ 	ActiveWorld addHighlightMorph: aMorph for: self outmostScriptEditor!

Item was added:
+ ----- Method: PhraseTileForTimesRepeat>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver."
+ 
+ 	super initialize.
+ 	self color: Color orange muchLighter.
+ 	self
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #shrinkWrap;
+ 		borderWidth: 1;
+ 		borderColor: ScriptingSystem standardTileBorderColor.
+ 	self setupCostume
+ !

Item was added:
+ ----- Method: PhraseTileForTimesRepeat>>mouseDown: (in category 'mouse') -----
+ mouseDown: evt 
+ 	"Handle a mouse-down on the receiver"
+ 
+ 	| guyToTake catViewer |
+ 	guyToTake _ TimesRepeatTile new.
+ 	guyToTake setNamePropertyTo: 'Repeat Tile' translated.
+ 	guyToTake position: evt position + (-25 at 8).
+ 
+ 	guyToTake formerPosition: ActiveHand position.
+ 	"self startSteppingSelector: #trackDropZones."
+ 	(catViewer := self ownerThatIsA: CategoryViewer) ifNotNil:
+ 		[guyToTake setProperty: #newPermanentPlayer toValue: catViewer scriptedPlayer.
+ 		guyToTake setProperty: #newPermanentScript toValue: true].
+ 	guyToTake justGrabbedFromViewer: true.
+ 
+ 	^ evt hand grabMorph: guyToTake
+ !

Item was added:
+ ----- Method: PhraseTileForTimesRepeat>>setupCostume (in category 'initialization') -----
+ setupCostume
+ 	"Set up the details that make up the receiver's appearance."
+ 
+ 	| stringMorph |
+ 	stringMorph _ StringMorph new contents: 'Repeat' translated.
+ 	stringMorph name: 'Repeat' translated.
+ 	stringMorph font: Preferences standardEToysFont.
+ 	self addMorphBack: stringMorph.
+ 	self addMorphBack: (Morph new color: color;
+ 			 extent: 15 @ 5).
+ 
+ 	stringMorph _ StringMorph new contents: 'Times' translated.
+ 	stringMorph name: 'Times' translated.
+ 	stringMorph font: Preferences standardEToysFont.
+ 	self addMorphBack: stringMorph.
+ 	self addMorphBack: (Morph new color: color;
+ 			 extent: 15 @ 5).
+ !

Item was changed:
  ----- Method: PhraseTileMorph class>>defaultNameStemForInstances (in category 'scripting') -----
  defaultNameStemForInstances
+ 	^ 'PhraseTile' translatedNoop!
- 	^ 'PhraseTile'!

Item was added:
+ ----- Method: PhraseTileMorph>>aboutToBeAcceptedInScriptor (in category '*Etoys-Squeakland-miscellaneous') -----
+ aboutToBeAcceptedInScriptor
+ 	"The receiver is about to be accepted in a Scriptor.  Adjust state information accordingly."
+ 
+ 	justGrabbedFromViewer := false!

Item was added:
+ ----- Method: PhraseTileMorph>>addCommandFeedback: (in category '*Etoys-Squeakland-hilighting') -----
+ addCommandFeedback: evt
+ 	"Add screen feedback showing what would be torn off in a drag"
+ 
+ 	| aMorph |
+ 	(self owner owner isMemberOf: PhraseTileMorph)
+ 		ifTrue: [self owner owner addCommandFeedback: evt. ^ self].
+ 	aMorph _ RectangleMorph new bounds: ((self topLeft - (2 at 1)) corner: ((submorphs at: (2 max: submorphs size)) bottomRight + (2 at 1))).
+ 	"inHotZone _ evt ifNil: [true] ifNotNil: [rect containsPoint: evt cursorPoint]."
+ 	aMorph beTransparent; borderWidth: 2; borderColor: ScriptingSystem commandFeedback; lock.
+ 	ActiveWorld addHighlightMorph: aMorph for: self outmostScriptEditor!

Item was added:
+ ----- Method: PhraseTileMorph>>assignmentNodeWith: (in category '*Etoys-Squeakland-code generation') -----
+ assignmentNodeWith: encoder
+ 
+ 	| suffix rec sel args left op right m |
+ 	rec _ submorphs first parseNodeWith: encoder.
+ 	
+ 	suffix _ submorphs second operatorForSexpAssignmentSuffix: submorphs second assignmentSuffix.
+ 	sel _ submorphs second assignmentRootForParseNode.
+ 
+ 	args _ WriteStream on: (Array new: 3).
+ 	(submorphs second isMemberOf: AssignmentTileMorph) ifFalse: [
+ 		args nextPut: (submorphs second parseNodeWith: encoder).
+ 		sel _ (sel, 'to:') asSymbol.
+ 	].
+ 
+ 	suffix isEmpty ifFalse: [
+ 		left _ self updatingOperatorNodeWith: encoder.
+ 		op _ (AssignmentTileMorph new operatorForAssignmentSuffix: suffix) asSymbol.
+ 		right _ self convertPrecedenceInParseNode: (submorphs third parseNodeWith: encoder) with: encoder.
+ 		m _ MessageNode new
+ 				receiver: left
+ 				selector: op
+ 				arguments: (Array with: right)
+ 				precedence: (op precedence)
+ 				from: encoder
+ 				sourceRange: nil.
+ 
+ 		args nextPut: m.
+ 	] ifTrue: [
+ 		args nextPut: (self convertPrecedenceInParseNode: (submorphs third parseNodeWith: encoder) with: encoder).
+ 	].
+ 	^ MessageNode new 
+ 				receiver: rec
+ 				selector: sel
+ 				arguments: args contents
+ 				precedence: (sel asSymbol precedence)
+ 				from: encoder
+ 				sourceRange: nil.!

Item was added:
+ ----- Method: PhraseTileMorph>>colorNodeFor:with: (in category '*Etoys-Squeakland-code generation') -----
+ colorNodeFor: aColor with: encoder
+ 
+ 	"^ MessageNode new
+ 				receiver: (encoder encodeVariable: #Color)
+ 				selector: #r:g:b:
+ 				arguments: (Array with: (encoder encodeLiteral: aColor red)
+ 									with: (encoder encodeLiteral: aColor green)
+ 									with: (encoder encodeLiteral: aColor blue))
+ 				precedence: (#r:g:b: precedence)
+ 				from: encoder
+ 				sourceRange: nil."
+ 	^ encoder encodeLiteral: aColor.
+ !

Item was added:
+ ----- Method: PhraseTileMorph>>colorSeerNodeWith: (in category '*Etoys-Squeakland-code generation') -----
+ colorSeerNodeWith: encoder
+ 
+ 	| rec sel args |
+ 	rec _ submorphs first parseNodeWith: encoder.
+ 	sel _ #color:sees:.
+ 	args _ OrderedCollection new: 2.
+ 	args add: (self colorNodeFor: submorphs second colorSwatch color with: encoder).
+ 	args add: (submorphs third parseNodeWith: encoder).
+ 	^ MessageNode new
+ 				receiver: rec
+ 				selector: sel
+ 				arguments: args asArray
+ 				precedence: (sel precedence)
+ 				from: encoder
+ 				sourceRange: nil.
+ !

Item was added:
+ ----- Method: PhraseTileMorph>>convertPrecedenceInParseNode:with: (in category '*Etoys-Squeakland-code generation') -----
+ convertPrecedenceInParseNode: message with: encoder
+ 
+ 	| e w list |
+ 	w _ WriteStream on: (Array new: 3).
+ 	message eToysExpFlattenOn: w.
+ 	list _ w contents.
+ 	e _ EToyExpressionTransformer2 new newNodeFromList: list encoder: encoder.
+ 	^  e transform.
+ !

Item was added:
+ ----- Method: PhraseTileMorph>>convertPrecedenceOfArgsInParseNode:with: (in category '*Etoys-Squeakland-code generation') -----
+ convertPrecedenceOfArgsInParseNode: message with: encoder
+ 
+ 	| e r w list |
+ 	message arguments size > 0 ifTrue: [
+ 		w _ WriteStream on: (Array new: 3).
+ 		message arguments first  eToysExpFlattenOn: w.
+ 		list _ w contents.
+ 		e _ EToyExpressionTransformer2 new newNodeFromList: list encoder: encoder.
+ 		r _ e transform.
+ 		message arguments at: 1 put: r.
+ 		^ message.
+ 	] ifFalse: [
+ 		^ message.
+ 	].
+ !

Item was added:
+ ----- Method: PhraseTileMorph>>createMultipleTestScripts: (in category '*Etoys-Squeakland-mouse') -----
+ createMultipleTestScripts: aCount
+ 	"Simulate the action of dropping a copy of the receiver to launch a new script -- for performance testing.  To use:  Open an Inspector on some tile command in a Viewer, e.g. on 'Car forward 5'.  In the trash pane of that Inspector, then, evaluate expressions like:
+      	[self createMultipleTestScripts: 10] timeToRun.
+ 	and
+ 		MessageTally spyOn:  [self createMultipleTestScripts: 4]
+ "
+ 
+ 	| aPosition |
+ 	aPosition := 10 at 10.
+ 	1 to: aCount do:
+ 		[:i | self forceScriptCreationAt: aPosition.
+ 		aPosition := aPosition + (0 @ 50). "avoid dropping into existing scriptor"
+ 		ActiveWorld doOneCycle]  "refresh viewer"!

Item was added:
+ ----- Method: PhraseTileMorph>>evaluateOn: (in category '*Etoys-Squeakland-etoys-debugger') -----
+ evaluateOn: anEtoysDebugger
+ 	^ anEtoysDebugger evaluatePhrase: self!

Item was added:
+ ----- Method: PhraseTileMorph>>forceScriptCreationAt: (in category '*Etoys-Squeakland-mouse') -----
+ forceScriptCreationAt: aPosition
+ 	"For performance testing."
+ 
+ 	 | dup | 
+ 	dup _ self duplicate.
+ 	dup eventHandler: nil.   "Remove viewer-related evt mouseover feedback"
+ 	dup formerPosition: ActiveHand position.
+ 	ActiveHand attachMorph: dup.
+ 	ActiveHand simulateMorphDropAt: aPosition!

Item was changed:
  ----- Method: PhraseTileMorph>>initialize (in category 'initialization') -----
  initialize
  	"Initialize a nascent instance"
  
  	super initialize.
+ 	resultType _ #unknown.
- 	resultType := #unknown.
- 	brightenedOnEnter := false.
  	self wrapCentering: #center; cellPositioning: #leftCenter.
  	self hResizing: #shrinkWrap.
+ 	self vResizing: #spaceFill.
+ 	self borderWidth: 0.
- 	borderWidth := 0.
  	self layoutInset: 0.
  	self extent: 5 at 5.  "will grow to fit"
+ 	self minCellSize: 0 @ TileMorph defaultH.
+ 	self minHeight: TileMorph defaultH.
+ 	justGrabbedFromViewer _ true.  "All new PhraseTileMorphs that go through the initialize process (rather than being copied) are placed in viewers; the clones dragged out from them will thus have this set the right way; the drop code resets this to false"
- 	self minCellSize: (0 @ (Preferences standardEToysFont height rounded + 10)).
- 	justGrabbedFromViewer := true.  "All new PhraseTileMorphs that go through the initialize process (rather than being copied) are placed in viewers; the clones dragged out from them will thus have this set the right way; the drop code resets this to false"
  !

Item was added:
+ ----- Method: PhraseTileMorph>>isAssignment (in category '*Etoys-Squeakland-code generation') -----
+ isAssignment
+ 
+ 	^ (submorphs at: 2) isKindOf: AssignmentTileMorph.
+ !

Item was added:
+ ----- Method: PhraseTileMorph>>isColorSeer (in category '*Etoys-Squeakland-code generation') -----
+ isColorSeer
+ 
+ 	^ (submorphs at: 2) isKindOf: ColorSeerTile.
+ !

Item was added:
+ ----- Method: PhraseTileMorph>>isGetter: (in category '*Etoys-Squeakland-code generation') -----
+ isGetter: aSymbol
+ 
+ 	^ (aSymbol beginsWith: 'get').
+ !

Item was changed:
  ----- Method: PhraseTileMorph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
  justDroppedInto: newOwner event: evt
  	"Phrase tiles only auto-expand if they originate from viewers.  Any phrase tile, once dropped, loses its auto-phrase-expansion thing"
  
+ 	(justGrabbedFromViewer = true and: [newOwner isKindOf: Viewer]) ifTrue: [
+ 		self formerPosition ifNotNil: [
+ 			^ self vanishAfterSlidingTo: self formerPosition event: evt
+ 		].
+ 	].
+ 	justGrabbedFromViewer _ false.
+ 	super justDroppedInto: newOwner event: evt.
+ 
+ 	((owner isKindOf: TilePadMorph) and: [submorphs size = 3] and: [#(bearingTo: distanceToPlayer:) includes:  submorphs second operatorOrExpression])
+ 		ifTrue:
+ 			[owner wrapInFunction.
+ 			owner owner operator: #grouped wording: '()'  helpString: 'parenthesized' translated pad: owner.
+ 			owner scriptEdited]!
- 	justGrabbedFromViewer := false.
- 	super justDroppedInto: newOwner event: evt!

Item was changed:
  ----- Method: PhraseTileMorph>>morphToDropInPasteUp: (in category 'mouse') -----
  morphToDropInPasteUp: aPasteUp
  	"Answer the morph to drop in aPasteUp, given that the receiver is the putative droppee"
  
  	| actualObject itsSelector aScriptor pos aWatcher op |
  
+ 	((actualObject _ self actualObject) isNil or: [actualObject isPlayerLike not] or:  [actualObject costume isInWorld not]) ifTrue:
+ 		[^ ScriptingTileHolder around: self].
+ 
- 	((actualObject := self actualObject) isNil or: [actualObject costume isInWorld not]) ifTrue: [^ self].
  	self isCommand ifFalse:  "Can't expand to a scriptor, but maybe launch a watcher..."
+ 		[^ (Preferences dropProducesWatcher and: [(#(unknown command) includes: self resultType) not] and:
+ 			[(op _ self operatorTile operatorOrExpression) notNil] and: [op numArgs = 0] and: [(Vocabulary gettersForbiddenFromWatchers includes: op) not])
- 		[^ (Preferences dropProducesWatcher
- 			and: [(#(unknown command) includes: self resultType) not
- 			and: [(op := self operatorTile operatorOrExpression) notNil
- 			and: [op numArgs = 0
- 			and: [(Vocabulary gettersForbiddenFromWatchers includes: op) not]]]])
  			ifTrue:
+ 				[aWatcher _ WatcherWrapper new fancyForPlayer: self associatedPlayer getter: op.
- 				[aWatcher := WatcherWrapper new fancyForPlayer: self associatedPlayer getter: op.
  				aWatcher position: self position]
  			ifFalse:
+ 				[ScriptingTileHolder around: self]].
- 				[self]].
  
+ 	(aPasteUp automaticPhraseExpansion and: [self justGrabbedFromViewer])  ifFalse: [^ ScriptingTileHolder around: self].
- 	self justGrabbedFromViewer ifFalse: [^ self].
  	actualObject assureUniClass.
+ 	itsSelector _ self userScriptSelector.
+ 	pos _ self position.
+ 	aScriptor _ itsSelector isEmptyOrNil
- 	itsSelector := self userScriptSelector.
- 	pos := self position.
- 	aScriptor := itsSelector isEmptyOrNil
  		ifFalse:
  			[actualObject scriptEditorFor: itsSelector]
  		ifTrue:
  			["It's a system-defined selector; construct an anonymous scriptor around it"
  			actualObject newScriptorAround: self].
+ 	aScriptor ifNil:[^ ScriptingTileHolder around: self].
- 	aScriptor ifNil:[^self].
  	(self hasOwner: aScriptor) ifTrue:[
  		aScriptor fullBounds. "force layout"
  		aScriptor position: pos - self position.
  	] ifFalse:[
  		aScriptor position: self position.
  	].
+ 	(aScriptor valueOfProperty: #needsLayoutFixed) ifNotNil: [
+ 		aScriptor removeProperty: #needsLayoutFixed.
+ 		aScriptor fixLayout
+ 	].
+ 
  	^ aScriptor!

Item was changed:
  ----- Method: PhraseTileMorph>>mouseDown: (in category 'mouse') -----
  mouseDown: evt 
  	"Handle a mouse-down on the receiver"
  
  	| ed guyToTake dup enclosingPhrase |
+ 	self removeHighlightFeedback.
  	self isPartsDonor ifTrue:
+ 		[dup _ self duplicate.
- 		[dup := self duplicate.
  		dup eventHandler: nil.   "Remove viewer-related evt mouseover feedback"
  		evt hand attachMorph: dup.
+ 		dup position: evt position + (-25 at 8).
- 		dup position: evt position.
  		"So that the drag vs. click logic works"
  		dup formerPosition: evt position.
  		^ self].
  	submorphs isEmpty
  		ifTrue: [^ self].
  
+ 	guyToTake _ self.
+ 	[(enclosingPhrase _ guyToTake ownerThatIsA: PhraseTileMorph) notNil] whileTrue:
+ 		[guyToTake _ enclosingPhrase].  "This logic always grabs the outermost phrase, for now anyway"
- 	guyToTake := self.
- 	[(enclosingPhrase := guyToTake ownerThatIsA: PhraseTileMorph) notNil] whileTrue:
- 		[guyToTake := enclosingPhrase].  "This logic always grabs the outermost phrase, for now anyway"
  	
  	"the below had comment: 'picking me out of another phrase'"
  	"owner class == TilePadMorph
  		ifTrue:
+ 			[(ss _ submorphs first) class == TilePadMorph
+ 				ifTrue: [ss _ ss submorphs first].
+ 			guyToTake _  ss veryDeepCopy]."
- 			[(ss := submorphs first) class == TilePadMorph
- 				ifTrue: [ss := ss submorphs first].
- 			guyToTake :=  ss veryDeepCopy]."
  
+ 	(ed _ self enclosingEditor) ifNil: [^ evt hand grabMorph: guyToTake].
- 	(ed := self enclosingEditor) ifNil: [^ evt hand grabMorph: guyToTake].
  	evt hand grabMorph: guyToTake.
  	ed startStepping.
  	ed mouseEnterDragging: evt.
  	ed setProperty: #justPickedUpPhrase toValue: true.
  !

Item was added:
+ ----- Method: PhraseTileMorph>>operatorNodeWith: (in category '*Etoys-Squeakland-code generation') -----
+ operatorNodeWith: encoder
+ 
+ 	| sel rec args |
+ 	sel _ submorphs second operatorOrExpression.
+ 	sel _ (TileMorph classPool at: #EqualityOperators) at: sel ifAbsent: [sel].
+ 	rec _ submorphs first parseNodeWith: encoder.
+ 	args _ WriteStream on: (Array new: 3).
+ 
+ 	((submorphs second isMemberOf: TileCommandWithArgumentMorph) or: [
+ 		 submorphs second isMemberOf: KedamaGetColorComponentTile]) ifTrue: [
+ 			args nextPut: (submorphs second parseNodeWith: encoder).
+ 	].
+ 
+ 	(3 to: submorphs size) do: [:e |
+ 		args nextPut: ((submorphs at: e) parseNodeWith: encoder).
+ 	].
+ 	^ MessageNode new
+ 				receiver: rec
+ 				selector: sel
+ 				arguments: args contents
+ 				precedence: (sel precedence)
+ 				from: encoder
+ 				sourceRange: nil.
+ !

Item was added:
+ ----- Method: PhraseTileMorph>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') -----
+ parseNodeWith: encoder
+ 
+ 	^ self parseNodeWith: encoder asStatement: false.
+ !

Item was added:
+ ----- Method: PhraseTileMorph>>parseNodeWith:asStatement: (in category '*Etoys-Squeakland-code generation') -----
+ parseNodeWith: encoder asStatement: aBoolean
+ 
+ 	| ret |
+ 	submorphs size >= 2 ifTrue: [
+ 		self isAssignment ifTrue: [
+ 			^ self assignmentNodeWith: encoder.
+ 		].
+ 		self isColorSeer ifTrue: [
+ 			^ self colorSeerNodeWith: encoder.
+ 		].
+ 		(true) ifTrue: [
+ 			ret _ self operatorNodeWith: encoder.
+ 			aBoolean ifTrue: [^ self convertPrecedenceOfArgsInParseNode: ret with: encoder].
+ 			^ ret.
+ 		].
+ 	].
+ 	ret _ submorphs first parseNodeWith: encoder.
+ 	aBoolean ifTrue: [^ self convertPrecedenceInParseNode: ret with: encoder].
+ 	^ ret.
+ !

Item was added:
+ ----- Method: PhraseTileMorph>>removeHighlightFeedback (in category '*Etoys-Squeakland-hilighting') -----
+ removeHighlightFeedback
+ 	"Remove any existing highlight feedback"
+ 
+ 	ActiveWorld removeHighlightFeedback.
+ !

Item was changed:
  ----- Method: PhraseTileMorph>>replacePlayerInReadoutWith: (in category 'kedama') -----
  replacePlayerInReadoutWith: aPlayer 
  
  	| tile |
+ 	tile _ self firstMorphBearingKedamaPlayer.
- 	tile := self firstMorphBearingKedamaPlayer.
  	tile ifNil: [^ self].
  	(tile isMemberOf: TileMorph) ifFalse: [^ self].
  	tile type = #objRef ifFalse: [^ self].
  	tile referToSimilarObject: aPlayer.
  
  	self allMorphsDo: [:e |
  		((e isMemberOf: UpdatingStringMorph) or: [e isMemberOf: UpdatingRectangleMorph]) ifTrue: [
  			e target isPlayerLike ifTrue: [
  				e target: aPlayer
  			].
  		].
+ 		(e isMemberOf: KedamaPatchTile) ifTrue: [
+ 			e usePatch: (aPlayer costume renderedMorph kedamaWorld defaultPatch player).
+ 		].
  	].!

Item was added:
+ ----- Method: PhraseTileMorph>>replacePlayerWith: (in category '*Etoys-Squeakland-kedama') -----
+ replacePlayerWith: aPlayer 
+ 	"Kedama hook."
+ 
+ 	| tile patch |
+ 	aPlayer isPlayerLike ifFalse: [^ self].
+ 	aPlayer isPrototypeTurtlePlayer ifTrue: [
+ 		tile _ self firstMorphBearingKedamaPlayer.
+ 		tile ifNil: [^ self].
+ 		(tile isMemberOf: TileMorph) ifFalse: [^ self].
+ 		tile type = #objRef ifFalse: [^ self].
+ 		tile referToSimilarObject: aPlayer.
+ 		patch _ aPlayer costume renderedMorph kedamaWorld defaultPatch player.
+ 	] ifFalse: [
+ 		(aPlayer costume renderedMorph isMemberOf: KedamaPatchMorph) ifTrue: [
+ 			patch _ aPlayer.
+ 		] ifFalse: [^ self].
+ 	].
+ 			
+ 	self allMorphsDo: [:e |
+ 		((e isMemberOf: UpdatingStringMorph) or: [e isMemberOf: UpdatingRectangleMorph]) ifTrue: [
+ 			e target isPlayerLike ifTrue: [
+ 				e target costume renderedMorph class = aPlayer costume renderedMorph class ifTrue: [
+ 					e target: aPlayer
+ 				].
+ 			].
+ 		].
+ 		(e isMemberOf: KedamaPatchTile) ifTrue: [
+ 			e usePatch: patch.
+ 		].
+ 	].!

Item was changed:
  ----- Method: PhraseTileMorph>>setAngleToOperator:type:rcvrType:argType: (in category 'initialization') -----
  setAngleToOperator: opSymbol type: opType rcvrType: rcvrType argType: argType
  	"Set the operator, type, receiver type, and argument type for the phrase"
  
  	| aTileMorph |
  
+ 	resultType _ opType.
- 	resultType := opType.
  	opType ifNotNil: [self color: (ScriptingSystem colorForType: opType)].
  	self removeAllMorphs.
  	self addMorph: (TilePadMorph new setType: rcvrType).
+ 	aTileMorph _ TileCommandWithArgumentMorph newKedamaAngleToTile.
+ 	aTileMorph adoptVocabulary: self currentVocabulary.
- 	aTileMorph := KedamaAngleToTile new adoptVocabulary: self currentVocabulary.
  	self addMorphBack: ((aTileMorph setOperator: opSymbol asString) typeColor: color).
+ !
- 	opSymbol numArgs = 1 ifTrue:
- 		[self addMorphBack: (TilePadMorph new setType: (argType ifNil: [#Object]))]!

Item was changed:
  ----- Method: PhraseTileMorph>>setBounceOnOperator:type:rcvrType:argType: (in category 'initialization') -----
  setBounceOnOperator: opSymbol type: opType rcvrType: rcvrType argType: argType
  	"Set the operator, type, receiver type, and argument type for the phrase"
  
  	| aTileMorph |
  
+ 	resultType _ opType.
- 	resultType := opType.
  	opType ifNotNil: [self color: (ScriptingSystem colorForType: opType)].
  	self removeAllMorphs.
  	self addMorph: (TilePadMorph new setType: rcvrType).
+ 	aTileMorph _ TileCommandWithArgumentMorph newKedamaBounceOnTile.
+ 	aTileMorph adoptVocabulary: self currentVocabulary.
- 	aTileMorph := KedamaBounceOnTile new adoptVocabulary: self currentVocabulary.
  	self addMorphBack: ((aTileMorph setOperator: opSymbol asString) typeColor: color).
+ !
- 	opSymbol numArgs = 1 ifTrue:
- 		[self addMorphBack: (TilePadMorph new setType: (argType ifNil: [#Object]))]!

Item was changed:
  ----- Method: PhraseTileMorph>>setDistanceToOperator:type:rcvrType:argType: (in category 'initialization') -----
  setDistanceToOperator: opSymbol type: opType rcvrType: rcvrType argType: argType
  	"Set the operator, type, receiver type, and argument type for the phrase"
  
  	| aTileMorph |
  
+ 	resultType _ opType.
- 	resultType := opType.
  	opType ifNotNil: [self color: (ScriptingSystem colorForType: opType)].
  	self removeAllMorphs.
  	self addMorph: (TilePadMorph new setType: rcvrType).
+ 	aTileMorph _ TileCommandWithArgumentMorph newKedamaDistanceToTile.
+ 	aTileMorph adoptVocabulary: self currentVocabulary.
- 	aTileMorph := KedamaDistanceToTile new adoptVocabulary: self currentVocabulary.
  	self addMorphBack: ((aTileMorph setOperator: opSymbol asString) typeColor: color).
+ !
- 	opSymbol numArgs = 1 ifTrue:
- 		[self addMorphBack: (TilePadMorph new setType: (argType ifNil: [#Object]))]!

Item was changed:
  ----- Method: PhraseTileMorph>>setGetColorComponentOperator:componentName:type:rcvrType:argType: (in category 'initialization') -----
  setGetColorComponentOperator: opSymbol componentName: componentName type: opType rcvrType: rcvrType argType: argType
  	"Set the operator, type, receiver type, and argument type for the phrase"
  
  	| aTileMorph |
  
+ 	resultType _ opType.
- 	resultType := opType.
  	opType ifNotNil: [self color: (ScriptingSystem colorForType: opType)].
  	self removeAllMorphs.
  	self addMorph: (TilePadMorph new setType: rcvrType).
+ 	aTileMorph _ KedamaGetColorComponentTile new adoptVocabulary: self currentVocabulary.
- 	aTileMorph := KedamaGetColorComponentTile new adoptVocabulary: self currentVocabulary.
  	aTileMorph componentName: componentName.
  	self addMorphBack: ((aTileMorph setOperator: opSymbol asString) typeColor: color).
+ !
- 	opSymbol numArgs = 1 ifTrue:
- 		[self addMorphBack: (TilePadMorph new setType: (argType ifNil: [#Object]))]!

Item was changed:
  ----- Method: PhraseTileMorph>>setGetPixelOperator:type:rcvrType:argType: (in category 'initialization') -----
  setGetPixelOperator: opSymbol type: opType rcvrType: rcvrType argType: argType
  	"Set the operator, type, receiver type, and argument type for the phrase"
  
  	| aTileMorph |
  
+ 	resultType _ opType.
- 	resultType := opType.
  	opType ifNotNil: [self color: (ScriptingSystem colorForType: opType)].
  	self removeAllMorphs.
  	self addMorph: (TilePadMorph new setType: rcvrType).
+ 	aTileMorph _ TileCommandWithArgumentMorph newKedamaGetPatchValueTile.
+ 	aTileMorph adoptVocabulary: self currentVocabulary.
- 	aTileMorph := KedamaGetPixelValueTile new adoptVocabulary: self currentVocabulary.
  	self addMorphBack: ((aTileMorph setOperator: opSymbol asString) typeColor: color).
+ !
- 	opSymbol numArgs = 1 ifTrue:
- 		[self addMorphBack: (TilePadMorph new setType: (argType ifNil: [#Object]))]!

Item was changed:
  ----- Method: PhraseTileMorph>>setTurtleOfOperator:type:rcvrType:argType: (in category 'initialization') -----
  setTurtleOfOperator: opSymbol type: opType rcvrType: rcvrType argType: argType
  	"Set the operator, type, receiver type, and argument type for the phrase"
  
  	| aTileMorph |
  
+ 	resultType _ opType.
- 	resultType := opType.
  	opType ifNotNil: [self color: (ScriptingSystem colorForType: opType)].
  	self removeAllMorphs.
  	self addMorph: (TilePadMorph new setType: rcvrType).
+ 	aTileMorph _ TileCommandWithArgumentMorph newKedamaGetTurtleOfTile.
+ 	aTileMorph adoptVocabulary: self currentVocabulary.
- 	aTileMorph := KedamaTurtleOfTile new adoptVocabulary: self currentVocabulary.
  	self addMorphBack: ((aTileMorph setOperator: opSymbol asString) typeColor: color).
+ !
- 	opSymbol numArgs = 1 ifTrue:
- 		[self addMorphBack: (TilePadMorph new setType: (argType ifNil: [#Object]))]!

Item was changed:
  ----- Method: PhraseTileMorph>>setUpHillOperator:type:rcvrType:argType: (in category 'initialization') -----
  setUpHillOperator: opSymbol type: opType rcvrType: rcvrType argType: argType
  	"Set the operator, type, receiver type, and argument type for the phrase"
  
  	| aTileMorph |
  
+ 	resultType _ opType.
- 	resultType := opType.
  	opType ifNotNil: [self color: (ScriptingSystem colorForType: opType)].
  	self removeAllMorphs.
  	self addMorph: (TilePadMorph new setType: rcvrType).
+ 	aTileMorph _ TileCommandWithArgumentMorph newKedamaGetUpHillTile.
+ 	aTileMorph adoptVocabulary: self currentVocabulary.
- 	aTileMorph := KedamaUpHillTile new adoptVocabulary: self currentVocabulary.
  	self addMorphBack: ((aTileMorph setOperator: opSymbol asString) typeColor: color).
+ !
- 	opSymbol numArgs = 1 ifTrue:
- 		[self addMorphBack: (TilePadMorph new setType: (argType ifNil: [#Object]))]!

Item was added:
+ ----- Method: PhraseTileMorph>>sexpAssignmentWith: (in category '*Etoys-Squeakland-code generation') -----
+ sexpAssignmentWith: dictionary
+ 
+ 	| suffix n elements |
+ 	n _ SExpElement keyword: #assign.
+ 
+ 	(submorphs third isMemberOf: TilePadMorph) ifTrue: [
+ 		n attributeAt: #type put: submorphs third type.
+ 	].
+ 	
+ 	suffix _ submorphs second operatorForSexpAssignmentSuffix: submorphs second assignmentSuffix.
+ 	suffix isEmpty ifFalse: [
+ 		n attributeAt: #updating put: suffix.
+ 	].
+ 
+ 	n attributeAt: #property put: (submorphs second assignmentRoot).
+ 
+ 	elements _ WriteStream on: (Array new: 3).
+ 	elements nextPut: (submorphs first sexpWith: dictionary).
+ 	(submorphs second isMemberOf: AssignmentTileMorph) ifFalse: [
+ 		elements nextPut: (submorphs second sexpWith: dictionary).
+ 	].
+ 	elements nextPut: (submorphs third sexpWith: dictionary).
+ 	n elements: elements contents.
+ 	^ n.
+ !

Item was added:
+ ----- Method: PhraseTileMorph>>sexpColorSeerWith: (in category '*Etoys-Squeakland-code generation') -----
+ sexpColorSeerWith: dictionary
+ 
+ 	| n elements |
+ 	n _ SExpElement keyword: #send.
+ 	n attributeAt: #type put: 'Boolean'.
+ 	elements _ OrderedCollection new: 3.
+ 	elements add: ((SExpElement keyword: #selector) attributeAt: #selector put: 'color:sees:'; yourself).
+ 	elements add: (submorphs first sexpWith: dictionary).
+ 	elements add: ((SExpElement keyword: #literal)
+ 				attributeAt: #type put: 'Color';
+ 				attributeAt: #value put: submorphs second colorSwatch color printString;
+ 				yourself).
+ 	elements add: (submorphs third sexpWith: dictionary).
+ 	n elements: elements asArray.
+ 	^ n.
+ !

Item was added:
+ ----- Method: PhraseTileMorph>>sexpOperatorWith: (in category '*Etoys-Squeakland-code generation') -----
+ sexpOperatorWith: dictionary
+ 
+ 	| op n elements sel |
+ 	n _ SExpElement keyword: #send.
+ 
+ 	op _ submorphs second operatorOrExpression.
+ 	(self owner isKindOf: TilePadMorph) ifTrue: [
+ 		n attributeAt: #type put: owner type.
+ 	] ifFalse: [
+ 		(#(< > = <= >= ~= isDivisibleBy:) includes: op) ifTrue: [
+ 			"op _ (TileMorph classPool at: #EqualityOperators) at: op ifAbsent: [op]."
+ 			n attributeAt: #type put: 'Boolean'.
+ 		] ifFalse: [
+ 			n attributeAt: #type put: 'unknown'.  "this had some scary consequence".
+ 		].
+ 	].
+ 
+ 	elements _ OrderedCollection new: 3.
+ 	sel _ SExpElement keyword: #selector.
+ 	(self isGetter: op) ifTrue: [
+ 		sel attributeAt: #getter put: (Utilities inherentSelectorForGetter: op).
+ 	] ifFalse: [
+ 		sel attributeAt: #selector put: op.
+ 	].
+ 	elements add: sel.
+ 	elements add: (submorphs first sexpWith: dictionary).
+ 
+ 	((submorphs second isMemberOf: TileCommandWithArgumentMorph) or: [
+ 		 submorphs second isMemberOf: KedamaGetColorComponentTile]) ifTrue: [
+ 		elements add: (submorphs second sexpWith: dictionary)
+ 	].
+ 
+ 	(3 to: submorphs size) do: [:e |
+ 		elements add: ((submorphs at: e) sexpWith: dictionary).
+ 	].
+ 	n elements: elements asArray.
+ 	^ n.
+ !

Item was added:
+ ----- Method: PhraseTileMorph>>sexpWith: (in category '*Etoys-Squeakland-code generation') -----
+ sexpWith: dictionary
+ 
+ 	submorphs size >= 2 ifTrue: [
+ 		self isAssignment ifTrue: [
+ 			^ self sexpAssignmentWith: dictionary
+ 		].
+ 		self isColorSeer ifTrue: [
+ 			^ self sexpColorSeerWith: dictionary
+ 		].
+ 		(true) ifTrue: [
+ 			^ self sexpOperatorWith: dictionary
+ 		].
+ 	].
+ 	^ submorphs first sexpWith: dictionary.
+ !

Item was added:
+ ----- Method: PhraseTileMorph>>updatingOperatorNodeWith: (in category '*Etoys-Squeakland-code generation') -----
+ updatingOperatorNodeWith: encoder
+ 
+ 	| sel rec args |
+ 	sel _ Utilities getterSelectorFor: submorphs second assignmentRoot.
+ 	rec _ submorphs first parseNodeWith: encoder.
+ 	args _ WriteStream on: (Array new: 3).
+ 
+ 	((submorphs second isMemberOf: TileCommandWithArgumentMorph)
+ 		or: [(submorphs second isMemberOf: KedamaSetColorComponentTile)
+ 			or: [submorphs second isMemberOf: KedamaSetPixelValueTile]]) ifTrue: [
+ 				args nextPut: (submorphs second parseNodeWith: encoder).
+ 	].
+ 
+ 	^ MessageNode new
+ 				receiver: rec
+ 				selector: sel
+ 				arguments: args contents
+ 				precedence: (sel precedence)
+ 				from: encoder
+ 				sourceRange: nil.
+ !

Item was added:
+ AlignmentMorph subclass: #PhraseWrapperMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Scripting'!
+ 
+ !PhraseWrapperMorph commentStamp: '<historical>' prior: 0!
+ An alignment morph designed for use in scripting Viewers; it wraps a set of phrases in a category viewer, and repels attempts to drop phrases upon it.!

Item was added:
+ ----- Method: PhraseWrapperMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 	"Not to be instantiated from the menu"
+ 	^ false!

Item was added:
+ ----- Method: PhraseWrapperMorph>>isPartsBin (in category 'parts bin') -----
+ isPartsBin
+ 	^ true!

Item was added:
+ ----- Method: PhraseWrapperMorph>>repelsMorph:event: (in category 'dropping/grabbing') -----
+ repelsMorph: aMorph event: ev
+ 	^ (aMorph isKindOf: PhraseTileMorph) or:
+ 		[aMorph hasProperty: #newPermanentScript]!

Item was added:
+ ----- Method: PianoKeyboardMorph>>allowingChord (in category '*Etoys-Squeakland-accessing') -----
+ allowingChord
+ 	^ allowingChord == true.
+ !

Item was added:
+ ----- Method: PianoKeyboardMorph>>allowingChord: (in category '*Etoys-Squeakland-accessing') -----
+ allowingChord: aBoolean
+ 	| prevValue |
+ 	prevValue := allowingChord.
+ 	allowingChord := aBoolean.
+ 	(prevValue and: [allowingChord not]) ifTrue: [
+ 		self stopAllSound.
+ 	].
+ !

Item was added:
+ ----- Method: PianoKeyboardMorph>>chordFlagString (in category '*Etoys-Squeakland-menus') -----
+ chordFlagString
+ 	^ self allowingChord
+ 		ifTrue: ['<on>', 'sticky off' translated]
+ 		ifFalse: ['<off>', 'sticky on' translated]!

Item was added:
+ ----- Method: PianoKeyboardMorph>>soundPlayingList (in category '*Etoys-Squeakland-accessing') -----
+ soundPlayingList
+ 	"Answer the soundPlayingList, creating it at this time if necessary (happens when loading old projects)"
+ 
+ 	 ^ soundPlayingList ifNil: [soundPlayingList := Array new: self submorphs size].!

Item was added:
+ ----- Method: PianoKeyboardMorph>>soundPlayingListAt: (in category '*Etoys-Squeakland-accessing') -----
+ soundPlayingListAt: anInteger
+ 	"Answer the sound in my soundPlayingList at the given index; answer nil if the index is out of range."
+ 
+ 	^ self soundPlayingList at: anInteger ifAbsent: [nil]!

Item was added:
+ ----- Method: PianoKeyboardMorph>>stopAllSound (in category '*Etoys-Squeakland-private') -----
+ stopAllSound
+ 
+ 	1 to: submorphs size do: [:i |
+ 		self stopSoundAt: i.]
+ !

Item was added:
+ ----- Method: PianoKeyboardMorph>>stopSoundAt: (in category '*Etoys-Squeakland-private') -----
+ stopSoundAt: morphIndex
+ 
+ 	| sound noteMorph |
+ 	noteMorph := submorphs at: morphIndex.
+ 	frequency _ 0.
+ 	noteMorph
+ 		color: ((#(1 2 3 4 5) includes: (morphIndex - 1) \\ 12)
+ 				ifTrue: [blackKeyColor]
+ 				ifFalse: [whiteKeyColor]).
+ 	sound _ self soundPlayingListAt: morphIndex.
+ 	sound notNil
+ 		ifTrue: [sound stopGracefully.
+ 			self soundPlayingListAt: morphIndex put: nil]!

Item was added:
+ ----- Method: PianoKeyboardMorph>>toggleChord (in category '*Etoys-Squeakland-menus') -----
+ toggleChord
+ 	allowingChord _ allowingChord not!

Item was added:
+ ImageMorph subclass: #PinMorph
+ 	instanceVariableNames: 'component pinForm pinSpec wires'
+ 	classVariableNames: 'InputPinForm IoPinForm OutputPinForm'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Components'!

Item was added:
+ ----- Method: PinMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 	^ false!

Item was added:
+ ----- Method: PinMorph class>>initialize (in category 'class initialization') -----
+ initialize  "PinMorph initialize"
+ 	OutputPinForm _ Form extent: 8 at 8 depth: 1 fromArray:
+ 			#( 0 3221225472 4026531840 4227858432 4278190080 4227858432 4026531840 3221225472)
+ 		offset: 0 at 0.
+ 
+ 	IoPinForm _ Form extent: 8 at 8 depth: 1 fromArray:
+ 			#( 0 402653184 1006632960 2113929216 4278190080 2113929216 1006632960 402653184)
+ 		offset: 0 at 0.
+ 
+ 	InputPinForm _ OutputPinForm flipBy: #horizontal centerAt: 0 at 0.
+ !

Item was added:
+ ----- Method: PinMorph>>addModelVariable (in category 'variables') -----
+ addModelVariable
+ 	| accessors |
+ 	accessors _ component model addVariableNamed: component knownName , pinSpec pinName.
+ 	pinSpec modelReadSelector: accessors first modelWriteSelector: accessors second.
+ 	component initFromPinSpecs.
+ 	self connectedPins do: [:connectee | connectee shareVariableOf: self]!

Item was added:
+ ----- Method: PinMorph>>addWire: (in category 'wires') -----
+ addWire: aWireMorph
+ 	wires add: aWireMorph!

Item was added:
+ ----- Method: PinMorph>>canDockWith: (in category 'wires') -----
+ canDockWith: otherPin
+ 	"Later include data type compatibility and circularity as well"
+ 	(pinSpec isInputOnly and: [otherPin pinSpec isInputOnly]) ifTrue: [^ false].
+ 	(pinSpec isOutputOnly and: [otherPin pinSpec isOutputOnly]) ifTrue: [^ false].
+ 	^ true!

Item was added:
+ ----- Method: PinMorph>>component:pinSpec: (in category 'initialization') -----
+ component: aComponent pinSpec: spec
+ 	component _ aComponent.
+ 	pinSpec _ spec.
+ 	pinSpec isInput ifTrue: [pinForm _ InputPinForm].
+ 	pinSpec isOutput ifTrue: [pinForm _ OutputPinForm].
+ 	pinSpec isInputOutput ifTrue: [pinForm _ IoPinForm].
+ 	self image: pinForm!

Item was added:
+ ----- Method: PinMorph>>connectedPins (in category 'wires') -----
+ connectedPins
+ 	^ wires collect: [:w | w otherPinFrom: self]!

Item was added:
+ ----- Method: PinMorph>>delete (in category 'submorphs-add/remove') -----
+ delete
+ 	self unwire.
+ 	^ super delete!

Item was added:
+ ----- Method: PinMorph>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: evt
+ 
+ 	^ (evt yellowButtonPressed | evt blueButtonPressed) not
+ !

Item was added:
+ ----- Method: PinMorph>>hasVariable (in category 'variables') -----
+ hasVariable
+ 	^ pinSpec hasVariable!

Item was added:
+ ----- Method: PinMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	super initialize.
+ 	wires _ OrderedCollection new!

Item was added:
+ ----- Method: PinMorph>>isIsolated (in category 'wires') -----
+ isIsolated
+ 	^ wires isEmpty!

Item was added:
+ ----- Method: PinMorph>>mergeVariableWith: (in category 'variables') -----
+ mergeVariableWith: otherPin
+ 	"Change all pins with otherPin's selectors to these selectors,
+ 	and then remove the slot and accessors for the old selectors"
+ 	self removeModelVariable.
+ 	self connectedPins do:
+ 		[:connectee | connectee shareVariableOf: otherPin].
+ 	self shareVariableOf: otherPin!

Item was added:
+ ----- Method: PinMorph>>mouseDown: (in category 'event handling') -----
+ mouseDown: event
+ 	"Unshifted action is to move the pin (see mouseMove:)"
+ 	event shiftPressed ifTrue: [self startWiring: event].
+ !

Item was added:
+ ----- Method: PinMorph>>mouseMove: (in category 'event handling') -----
+ mouseMove: evt
+ 	evt shiftPressed ifTrue: [^ self].
+ 	self position: evt targetPoint.
+ 	self updateImage!

Item was added:
+ ----- Method: PinMorph>>pinSpec (in category 'accessing') -----
+ pinSpec
+ 	^ pinSpec!

Item was added:
+ ----- Method: PinMorph>>placeFromSpec (in category 'geometry') -----
+ placeFromSpec
+ 	| side corners c1 c2 |
+ 	side _ pinSpec pinLoc asInteger.  "1..4 ccw from left"
+ 	corners _ owner bounds corners.
+ 	c1 _ corners at: side.
+ 	c2 _ corners atWrap: side+1.
+ 	self position: (c1 + (c2 - c1 * pinSpec pinLoc fractionPart)).
+ 	self updateImage.!

Item was added:
+ ----- Method: PinMorph>>position: (in category 'geometry') -----
+ position: p 
+ 	"Adhere to owner bounds, and apply gridding"
+ 
+ 	| r side p1 corners c1 c2 sideIndex |
+ 	r := owner bounds.
+ 	side := r sideNearestTo: p.
+ 	p1 := r pointNearestTo: p.	"a point on the border"
+ 	p1 := (side = #top or: [side = #left]) 
+ 		ifTrue: [r topLeft + (p1 - r topLeft grid: 4 @ 4)]
+ 		ifFalse: [ r bottomRight + (p1 - r bottomRight grid: 4 @ 4)].
+ 
+ 	"Update pin spec(5) = side index + fraction along side"
+ 	corners := r corners.
+ 	sideIndex := #(#left #bottom #right #top) indexOf: side.
+ 	c1 := corners at: sideIndex.
+ 	c2 := corners atWrap: sideIndex + 1.
+ 	pinSpec pinLoc: sideIndex + ((p1 dist: c1) / (c2 dist: c1) min: 0.99999).
+ 
+ 	"Set new position with appropriate offset."
+ 	side = #top ifTrue: [super position: p1 - (0 @ 8)].
+ 	side = #left ifTrue: [super position: p1 - (8 @ 0)].
+ 	side = #bottom ifTrue: [super position: p1].
+ 	side = #right ifTrue: [super position: p1].
+ 	wires do: [:w | w pinMoved]!

Item was added:
+ ----- Method: PinMorph>>removeModelVariable (in category 'variables') -----
+ removeModelVariable
+ 	component model removeVariableNamed: pinSpec variableName.
+ 	self removeVariableAccess!

Item was added:
+ ----- Method: PinMorph>>removeVariableAccess (in category 'variables') -----
+ removeVariableAccess
+ 	pinSpec modelReadSelector: nil modelWriteSelector: nil.
+ 	component initFromPinSpecs!

Item was added:
+ ----- Method: PinMorph>>removeWire: (in category 'wires') -----
+ removeWire: aWireMorph
+ 	wires remove: aWireMorph!

Item was added:
+ ----- Method: PinMorph>>shareVariableOf: (in category 'variables') -----
+ shareVariableOf: otherPin
+ 	pinSpec modelReadSelector: otherPin pinSpec modelReadSelector
+ 			modelWriteSelector: otherPin pinSpec modelWriteSelector.
+ 	component initFromPinSpecs!

Item was added:
+ ----- Method: PinMorph>>startWiring: (in category 'wires') -----
+ startWiring: event 
+ 	"Start wiring from this pin"
+ 
+ 	| origin handle candidates candidate wiringColor wire |
+ 	origin := self wiringEndPoint.
+ 	candidates := OrderedCollection new.
+ 	"Later this could be much faster if we define pinMorphsDo:
+ 		so that it doesn't go too deep and bypasses non-widgets."
+ 	self pasteUpMorph allMorphsDo: 
+ 			[:m | 
+ 			((m isMemberOf: PinMorph) and: [m canDockWith: self]) 
+ 				ifTrue: [candidates add: m]].
+ 	handle := NewHandleMorph new 
+ 				followHand: event hand
+ 				forEachPointDo: 
+ 					[:newPoint | 
+ 					candidate := candidates detect: [:m | m containsPoint: newPoint]
+ 								ifNone: [nil].
+ 					wiringColor := candidate isNil ifTrue: [Color black] ifFalse: [Color red].
+ 					handle
+ 						removeAllMorphs;
+ 						addMorph: (PolygonMorph 
+ 									vertices: (Array with: origin with: newPoint)
+ 									color: Color black
+ 									borderWidth: 1
+ 									borderColor: wiringColor)]
+ 				lastPointDo: 
+ 					[:lastPoint | 
+ 					(self wireTo: candidate) 
+ 						ifTrue: 
+ 							[wire := (WireMorph 
+ 										vertices: (Array with: origin with: lastPoint)
+ 										color: Color black
+ 										borderWidth: 1
+ 										borderColor: Color black) fromPin: self toPin: candidate.
+ 							self pasteUpMorph addMorph: wire.
+ 							self addWire: wire.
+ 							candidate addWire: wire]].
+ 	event hand world addMorph: handle.
+ 	handle startStepping!

Item was added:
+ ----- Method: PinMorph>>unwire (in category 'wires') -----
+ unwire
+ 	"Remove wires one by one.  Not fastest, but by far simplest"
+ 
+ 	wires do: [:w | w delete].  "This is where all the work is done"!

Item was added:
+ ----- Method: PinMorph>>updateImage (in category 'geometry') -----
+ updateImage
+ 	"pinForm was made for right side.  Rotate/flip for other sides"
+ 
+ 	bounds left < owner bounds left ifTrue:  "left side"
+ 		[^ self image: (pinForm flipBy: #horizontal centerAt: 0 at 0)].
+ 	bounds bottom > owner bounds bottom ifTrue:  "bottom"
+ 		[^ self image: ((pinForm rotateBy: #left centerAt: 0 at 0)
+ 								flipBy: #vertical centerAt: 0 at 0)].
+ 	bounds right > owner bounds right ifTrue:  "right side"
+ 		[^ self image: pinForm].
+ 	bounds top < owner bounds top ifTrue:  "top"
+ 		[^ self image: (pinForm rotateBy: #left centerAt: 0 at 0)].
+ self halt: 'uncaught pin geometry case'!

Item was added:
+ ----- Method: PinMorph>>wireTo: (in category 'wires') -----
+ wireTo: otherPin 
+ 	"Note must return true or false indicating success"
+ 
+ 	(otherPin isNil or: [otherPin == self]) ifTrue: [^false].
+ 	self hasVariable 
+ 		ifTrue: 
+ 			[otherPin hasVariable 
+ 				ifTrue: [self mergeVariableWith: otherPin]
+ 				ifFalse: [otherPin shareVariableOf: self]]
+ 		ifFalse: 
+ 			[otherPin hasVariable 
+ 				ifTrue: [self shareVariableOf: otherPin]
+ 				ifFalse: 
+ 					[self addModelVariable.
+ 					otherPin shareVariableOf: self]].
+ 	component model changed: pinSpec modelReadSelector.
+ 	^true!

Item was added:
+ ----- Method: PinMorph>>wiringEndPoint (in category 'geometry') -----
+ wiringEndPoint
+ 	| side |
+ 	side _ owner bounds sideNearestTo: bounds center.
+ 	side = #left ifTrue: [^ self position + (0 at 4)].
+ 	side = #bottom ifTrue: [^ self position + (4 at 7)].
+ 	side = #right ifTrue: [^ self position + (7 at 4)].
+ 	side = #top ifTrue: [^ self position + (4 at 0)]!

Item was added:
+ Object subclass: #PinSpec
+ 	instanceVariableNames: 'pinName direction localReadSelector localWriteSelector modelReadSelector modelWriteSelector defaultValue pinLoc'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Components'!

Item was added:
+ ----- Method: PinSpec>>defaultValue (in category 'accessing') -----
+ defaultValue
+ 	^ defaultValue!

Item was added:
+ ----- Method: PinSpec>>hasVariable (in category 'variables') -----
+ hasVariable
+ 	^modelReadSelector notNil or: [modelWriteSelector notNil]!

Item was added:
+ ----- Method: PinSpec>>isInput (in category 'accessing') -----
+ isInput
+ 	direction = #input ifTrue: [^ true].
+ 	direction = #inputOutput ifTrue: [^ true].
+ 	direction = #ioAsInput ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: PinSpec>>isInputOnly (in category 'accessing') -----
+ isInputOnly
+ 	direction = #input ifTrue: [^ true].
+ 	direction = #ioAsInput ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: PinSpec>>isInputOutput (in category 'accessing') -----
+ isInputOutput
+ 	^ direction = #inputOutput!

Item was added:
+ ----- Method: PinSpec>>isOutput (in category 'accessing') -----
+ isOutput
+ 	direction = #output ifTrue: [^ true].
+ 	direction = #inputOutput ifTrue: [^ true].
+ 	direction = #ioAsOutput ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: PinSpec>>isOutputOnly (in category 'accessing') -----
+ isOutputOnly
+ 	direction = #output ifTrue: [^ true].
+ 	direction = #ioAsOutput ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: PinSpec>>localReadSelector (in category 'accessing') -----
+ localReadSelector
+ 	^ localReadSelector!

Item was added:
+ ----- Method: PinSpec>>localWriteSelector (in category 'accessing') -----
+ localWriteSelector
+ 	^ localWriteSelector!

Item was added:
+ ----- Method: PinSpec>>modelReadSelector (in category 'accessing') -----
+ modelReadSelector
+ 	^ modelReadSelector!

Item was added:
+ ----- Method: PinSpec>>modelReadSelector:modelWriteSelector: (in category 'accessing') -----
+ modelReadSelector: a modelWriteSelector: b
+ 	modelReadSelector _ a.
+ 	modelWriteSelector _ b!

Item was added:
+ ----- Method: PinSpec>>modelWriteSelector (in category 'accessing') -----
+ modelWriteSelector
+ 	^ modelWriteSelector!

Item was added:
+ ----- Method: PinSpec>>pinLoc (in category 'accessing') -----
+ pinLoc
+ 	^ pinLoc!

Item was added:
+ ----- Method: PinSpec>>pinLoc: (in category 'accessing') -----
+ pinLoc: x
+ 	pinLoc _ x!

Item was added:
+ ----- Method: PinSpec>>pinName (in category 'accessing') -----
+ pinName
+ 	^ pinName!

Item was added:
+ ----- Method: PinSpec>>pinName:direction:localReadSelector:localWriteSelector:modelReadSelector:modelWriteSelector:defaultValue:pinLoc: (in category 'initialization') -----
+ pinName: a direction: b localReadSelector: c localWriteSelector: d modelReadSelector: e modelWriteSelector: f defaultValue: g pinLoc: h
+ 	pinName _ a.
+ 	direction _ b.
+ 	localReadSelector _ c.
+ 	localWriteSelector _ d.
+ 	modelReadSelector _ e.
+ 	modelWriteSelector _ f.
+ 	defaultValue _ g.
+ 	pinLoc _ h!

Item was added:
+ ----- Method: PinSpec>>variableName (in category 'variables') -----
+ variableName
+ 	^ modelReadSelector!

Item was added:
+ MorphicModel subclass: #PlayWithMe1
+ 	instanceVariableNames: 'slider1 valuePrinter scrollBar1 listPane1 listPane2'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Models'!

Item was added:
+ ----- Method: PlayWithMe1 class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 	"Not to be instantiated from the menu"
+ 	^ false!

Item was added:
+ ----- Method: PlayWithMe1>>listPane1MenuButtonPressed: (in category 'input events') -----
+ listPane1MenuButtonPressed: arg1
+ 	self confirm: 'Do you like menu buttons?'!

Item was added:
+ ----- Method: PlayWithMe1>>listPane1NewSelection: (in category 'input events') -----
+ listPane1NewSelection: t1 
+ 	valuePrinter
+ 		contents: (t1 = 0
+ 				ifTrue: ['-']
+ 				ifFalse: [(listPane1 instVarNamed: 'list')
+ 						at: t1]).
+ 	listPane1 selectionIndex: t1.
+ 	listPane2 selectionIndex: t1!

Item was added:
+ ----- Method: PlayWithMe1>>listPane2MenuButtonPressed: (in category 'input events') -----
+ listPane2MenuButtonPressed: arg1
+ 	self confirm: 'Do you like menu buttons?'!

Item was added:
+ ----- Method: PlayWithMe1>>listPane2NewSelection: (in category 'input events') -----
+ listPane2NewSelection: t1 
+ 	valuePrinter
+ 		contents: (t1 = 0
+ 				ifTrue: ['-']
+ 				ifFalse: [(listPane2 instVarNamed: 'list')
+ 						at: t1]).
+ 	listPane2 selectionIndex: t1.
+ 	listPane1 selectionIndex: t1!

Item was added:
+ ----- Method: PlayWithMe1>>scrollBar1MenuButtonPressed: (in category 'input events') -----
+ scrollBar1MenuButtonPressed: arg1
+ 	self confirm: 'Do you like menu buttons?'!

Item was added:
+ ----- Method: PlayWithMe1>>scrollBar1Value: (in category 'input events') -----
+ scrollBar1Value: arg1
+ 	valuePrinter contents: arg1 printString.
+ 	slider1 value: arg1!

Item was added:
+ ----- Method: PlayWithMe1>>slider1Value: (in category 'public access') -----
+ slider1Value: x
+ 	valuePrinter contents: x printString.
+ 	scrollBar1 value: x!

Item was added:
+ SketchMorph subclass: #PlaybackInvoker
+ 	instanceVariableNames: 'caption contentArea tape beforeBitmap afterBitmap initialPicture finalPicture timesPlayed offeringHint autoStart autoDismiss whereToAppear postPlaybackImageFeature'
+ 	classVariableNames: 'HintForm'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !PlaybackInvoker commentStamp: 'sw 10/31/2006 03:21' prior: 0!
+ When clicked on by the user, open up an EventPlaybackSpace positioned within the receiver's container, ready to play back a given event tape with a given optional voice track.  
+ 
+ caption			A textual title for the exercise
+ contentArea		The reference bounds to which the coordinates in the tape are bound.
+ tape				An EventRecorder tape
+ voiceRecorder     An optional SoundRecorder
+ beforeBitmap		The bitmap of the receiver before the first time the user has requested the hint
+ afterBitmap		The bitmap of the receiver after the first time the user has requested the hint
+ timesPlayed		How many times the hint has been invoked
+ autoStart			If true, playback will happen automatically when the playback unit is opened.
+ autoDismiss       	If true, as soon as playback ends, the playback unit will go away, revealing the "afterBitmap" view of the receiver.
+ 
+ !

Item was added:
+ ----- Method: PlaybackInvoker class>>defaultNameStemForInstances (in category 'scripting') -----
+ defaultNameStemForInstances
+ 	"Answer the stem upon which object names are built."
+ 
+ 	^ 'Play' translatedNoop!

Item was added:
+ ----- Method: PlaybackInvoker class>>hintForm (in category 'accessing') -----
+ hintForm
+ 	"Answer the picture of the word Hint"
+ 
+ 	^ HintForm!

Item was added:
+ ----- Method: PlaybackInvoker class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"Class initialization."
+ 	"PlaybackInvoker initialize"
+ 
+ 	HintForm := Form
+ 	extent: 152 at 31
+ 	depth: 16
+ 	fromArray: #( 554041345 65537 65537 65537 65537 66593 0 0 0 24306 65537 65537 65537 65537 65537 81388 0 0 0 0 0 0 0 0 8454 65537 65537 65537 65537 65537 69271552 0 0 0 0 0 0 0 0 65537 65537 65537 71877 1939210240 0 0 0 0 0 15852 65537 65537 65537 65537 65537 1523712000 0 0 0 0 0 0 8454 65537 65537 65537 65537 65537 65537 65537 65537 65537 65537 65537 65537 65537 554106881 69271553 69271553 69271553 69271553 69272608 0 0 0 23250 69271553 69271553 69271553 69271553 69271553 69287404 0 0 0 0 0 0 0 0 8455 66593 66593 66593 66593 66593 69206016 0 0 0 0 0 0 0 0 69271553 69271553 69271553 69271553 692584448 0 0 0 0 0 15852 69271553 69271553 69271553 69271553 69271553 1592918016 0 0 0 0 0 0 8455 66593 66593 66593 66593 66593 66593 66593 66593 66593 66593 66593 66593 66593 1662212818 1523669714 65537 65537 1523735250 1523670770 0 0 0 29590 1523735250 1523664429 65537 71877 1523735250 1523673941 0 0 0 0 0 0 0 0 25363 1523735249 1523712001 65537 88786 1523735249 1592918016 0 0 0 0 0 0 0 0 1523735250 1523669714 65537 65537 83502 0 0 0 0 0 27477 1523669714 1523723625 65537 1523735250 1523669714 1939210240 0 0 0 0 0 0 8454 68707 1038891467 1038891467 1038891467 1038891467 484835329 65537 277035467 1038891467 1038891467 1038891467 1038884069 66592 0 0 69271553 69272608 0 0 0 0 0 0 0 23250 69271553 69280006 0 0 0 0 0 0 0 0 0 0 0 0 1057 66593 69206016 0 0 0 0 0 0 0 0 0 0 0 0 69271553 69271553 69271553 1731461120 0 0 0 0 0 0 15852 69272608 0 0 0 0 0 0 0 0 0 8455 73991 0 0 0 0 1038877729 66593 554041344 0 0 0 16909 66593 0 0 65537 66593 0 0 0 0 0 0 0 24306 65537 73990 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 69271552 0 0 0 0 0 0 0 0 0 0 0 0 65537 65537 65537 277050263 0 0 0 0 0 0 15852 66593 0 0 0 0 0 0 0 0 0 8454 73990 0 0 0 0 1038876673 65537 554041344 0 0 0 15852 65537 0 0 69271553 69272608 0 0 0 0 0 0 0 23250 69271553 69280006 0 0 0 0 0 0 0 0 0 0 0 0 1057 66593 69206016 0 0 0 0 0 0 0 0 0 0 0 0 69271553 138543105 69271553 69282120 0 0 0 0 0 0 15852 69272608 0 0 0 0 0 0 0 0 0 8455 73991 0 0 0 0 1038877729 66593 554041344 0 0 0 16908 66593 0 0 65537 66592 0 0 0 0 0 0 0 24306 65537 73990 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 69206016 0 0 0 0 0 0 0 0 0 0 0 0 65537 1038887239 65537 65537 1177354240 0 0 0 0 0 15852 66592 0 0 0 0 0 0 0 0 0 8454 73990 0 0 0 0 1038876673 65537 554041344 0 0 0 15852 66592 0 0 69271553 69272608 0 0 0 0 0 0 0 23250 69271553 69280006 0 0 0 0 0 0 0 0 0 0 0 0 1057 66593 69206016 0 0 0 0 0 0 0 0 0 0 0 0 69271553 1108177814 277020673 69271553 90899 0 0 0 0 0 15852 69272608 0 0 0 0 0 0 0 0 0 26420 1523738420 0 0 0 0 1038877729 66593 554041344 0 0 0 28533 1523736306 0 0 65537 66593 0 0 0 0 0 0 0 24306 65537 73990 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 69271552 0 0 0 0 0 0 0 0 0 0 0 0 65537 1038876672 1662189569 65537 67650 1939210240 0 0 0 0 15852 66593 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038876673 65537 554041344 0 0 0 0 0 0 0 69271553 69272608 0 0 0 0 0 0 0 23250 69271553 69280006 0 0 0 0 0 0 0 0 0 0 0 0 1057 66593 69206016 0 0 0 0 0 0 0 0 0 0 0 0 69271553 1108082688 17966 69271553 69271553 554106880 0 0 0 0 15852 69272608 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038877729 66593 554041344 0 0 0 0 0 0 0 65537 66592 0 0 0 0 0 0 0 24306 65537 73990 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 69206016 0 0 0 0 0 0 0 0 0 0 0 0 65537 1038876672 0 761856001 65537 81388 0 0 0 0 15852 66592 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038876673 65537 554041344 0 0 0 0 0 0 0 69271553 69272608 0 0 0 0 0 0 0 23250 69271553 69280006 0 0 0 0 0 0 0 0 0 0 0 0 1057 66593 69206016 0 0 0 0 0 0 0 0 0 0 0 0 69271553 1108148224 0 1939281060 69271553 69272608 1592918016 0 0 0 15852 69272608 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038877729 66593 554041344 0 0 0 0 0 0 0 65537 66592 1523669714 1523735250 1523669714 1523735250 1523669714 1523735250 1523669714 1523729965 65537 73990 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 69271552 0 0 0 0 0 0 0 0 0 0 0 0 65537 1038876672 0 26420 69271553 65537 138507158 0 0 0 15852 66593 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038876673 65537 554041344 0 0 0 0 0 0 0 69271553 69271553 69271553 69271553 69271553 69271553 69271553 69271553 69271553 69271553 69271553 69280006 0 0 0 0 0 0 0 0 0 0 0 0 1057 66593 69206016 0 0 0 0 0 0 0 0 0 0 0 0 69271553 1108082688 0 0 1315897345 69271553 69280006 0 0 0 15852 69272608 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038877729 66593 554041344 0 0 0 0 0 0 0 65537 65537 65537 65537 65537 65537 65537 65537 65537 65537 65537 73990 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 69206016 0 0 0 0 0 0 0 0 0 0 0 0 65537 1038876672 0 0 11625 65537 65537 1038876672 0 0 15852 66592 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038876673 65537 554041344 0 0 0 0 0 0 0 69271553 69272608 0 0 0 0 0 0 0 23250 69271553 69280006 0 0 0 0 0 0 0 0 0 0 0 0 1057 66593 69206016 0 0 0 0 0 0 0 0 0 0 0 0 69271553 1108148224 0 0 29590 415563777 69271553 69294802 0 0 15852 69272608 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038877729 66593 554041344 0 0 0 0 0 0 0 65537 66593 0 0 0 0 0 0 0 24306 65537 73990 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 69271552 0 0 0 0 0 0 0 0 0 0 0 0 65537 1038876672 0 0 0 1800734785 65537 67649 1800732672 0 15852 66593 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038876673 65537 554041344 0 0 0 0 0 0 0 69271553 69272608 0 0 0 0 0 0 0 23250 69271553 69280006 0 0 0 0 0 0 0 0 0 0 0 0 1057 66593 69206016 0 0 0 0 0 0 0 0 0 0 0 0 69271553 1108082688 0 0 0 22192 69271553 69271553 484769792 0 15852 69272608 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038877729 66593 554041344 0 0 0 0 0 0 0 65537 66592 0 0 0 0 0 0 0 24306 65537 73990 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 69206016 0 0 0 0 0 0 0 0 0 0 0 0 65537 1038876672 0 0 0 0 900333569 65537 80331 0 15852 66592 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038876673 65537 554041344 0 0 0 0 0 0 0 69271553 69272608 0 0 0 0 0 0 0 23250 69271553 69280006 0 0 0 0 0 0 0 0 0 0 0 0 1057 66593 69206016 0 0 0 0 0 0 0 0 0 0 0 0 69271553 1108148224 0 0 0 0 5284 69271553 69272608 1454440448 15852 69272608 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038877729 66593 554041344 0 0 0 0 0 0 0 65537 66593 0 0 0 0 0 0 0 24306 65537 73990 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 69271552 0 0 0 0 0 0 0 0 0 0 0 0 65537 1038876672 0 0 0 0 27477 69271553 65537 138505045 15852 66593 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038876673 65537 554041344 0 0 0 0 0 0 0 69271553 69272608 0 0 0 0 0 0 0 23250 69271553 69280006 0 0 0 0 0 0 0 0 0 0 0 0 1057 66593 69206016 0 0 0 0 0 0 0 0 0 0 0 0 69271553 1108082688 0 0 0 0 0 1592918017 69271553 69277893 15852 69272608 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038877729 66593 554041344 0 0 0 0 0 0 0 65537 66592 0 0 0 0 0 0 0 24306 65537 73990 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 69206016 0 0 0 0 0 0 0 0 0 0 0 0 65537 1038876672 0 0 0 0 0 15852 65537 65537 900349420 66592 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038876673 65537 554041344 0 0 0 0 0 0 0 69271553 69272608 0 0 0 0 0 0 0 23250 69271553 69280006 0 0 0 0 0 0 0 0 0 0 0 0 1057 66593 69206016 0 0 0 0 0 0 0 0 0 0 0 0 69271553 1108148224 0 0 0 0 0 0 554041345 69271553 69277892 69272608 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038877729 66593 554041344 0 0 0 0 0 0 0 65537 66593 0 0 0 0 0 0 0 24306 65537 73990 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 69271552 0 0 0 0 0 0 0 0 0 0 0 0 65537 1038876672 0 0 0 0 0 0 1939212353 65537 65537 66593 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038876673 65537 554041344 0 0 0 0 0 0 0 69271553 69272608 0 0 0 0 0 0 0 23250 69271553 69280006 0 0 0 0 0 0 0 0 0 0 0 0 1057 66593 69206016 0 0 0 0 0 0 0 0 0 0 0 0 69271553 1108082688 0 0 0 0 0 0 23250 69271553 69271553 69272608 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038877729 66593 554041344 0 0 0 0 0 0 0 65537 66592 0 0 0 0 0 0 0 24306 65537 73990 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 69206016 0 0 0 0 0 0 0 0 0 0 0 0 65537 1038876672 0 0 0 0 0 0 0 1177354241 65537 66592 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038876673 65537 554041344 0 0 0 0 0 0 0 69271553 69272608 0 0 0 0 0 0 0 23250 69271553 69280006 0 0 0 0 0 0 0 0 0 0 0 0 1057 66593 69206016 0 0 0 0 0 0 0 0 0 0 0 0 69271553 1108148224 0 0 0 0 0 0 0 9511 69271553 69272608 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1038877729 66593 554041344 0 0 0 0 0 554041345 65537 65537 65537 65537 66593 0 0 0 24306 65537 65537 65537 65537 65537 81388 0 0 0 0 0 0 0 0 8454 65537 65537 65537 65537 65537 69271552 0 0 0 0 0 0 0 0 65537 65537 65537 65537 65537 1038876672 0 0 0 0 0 29591 207749121 66593 0 0 0 0 0 0 0 0 0 0 0 0 0 1592918017 65537 65537 65537 65537 65537 1038876672 0 0 0 554106881 69271553 69271553 69271553 69271553 69272608 0 0 0 23250 69271553 69271553 69271553 69271553 69271553 69287404 0 0 0 0 0 0 0 0 8455 66593 66593 66593 66593 66593 69206016 0 0 0 0 0 0 0 0 69271553 69271553 69271553 69271553 69271553 1108082688 0 0 0 0 0 0 1731461121 69272608 0 0 0 0 0 0 0 0 0 0 0 0 0 1523713057 66593 66593 66593 66593 66593 1038876672 0 0 0 1662212818 1523669714 1523735250 1523669714 1523735250 1523670770 0 0 0 29590 1523735250 1523669714 1523735250 1523669714 1523735250 1523673941 0 0 0 0 0 0 0 0 25363 1523735249 1523735250 1523735249 1523735250 1523735249 1592918016 0 0 0 0 0 0 0 0 1523735250 1523669714 1523735250 1523669714 1523735250 1800732672 0 0 0 0 0 0 20079 484778246 0 0 0 0 0 0 0 0 0 0 0 0 0 1939299025 1523735250 1523735249 1523735250 1523735249 1523735250 1800732672 0 0 0) offset: 0 @ 0
+ "
+ HintForm display.
+ HintForm asSketchMorph openInWorld.
+ PlaybackInvoker initialize.
+ "!

Item was added:
+ ----- Method: PlaybackInvoker>>addCustomMenuItems:hand: (in category 'menu ') -----
+ addCustomMenuItems: aMenu hand: aHandMorph
+ 	"Add custom menu items to the menu"
+ 
+ 	super addCustomMenuItems: aMenu hand: aHandMorph.
+ 
+ 	aMenu addLine.
+ 	aMenu addUpdating: #autoStartString  target: self action: #toggleAutoStart.
+ 	aMenu addUpdating: #autoDismissString  target: self action: #toggleAutoDismiss.
+ 	aMenu addUpdating: #postPlaybackImageFeatureString target: self action: #togglePostPlaybackImageFeature.
+ 	aMenu addLine.
+ 	aMenu addUpdating: #appearAtScreenCenterString target: self action: #appearAtScreenCenter.
+ 	aMenu addUpdating: #appearAtContainerOriginString target: self action: #appearAtContainerOrigin.
+ 	aMenu addUpdating: #appearAtButtonPositionString target: self action: #appearAtButtonPosition.
+ 
+ 	aMenu addTranslatedList: #(
+ 		-
+ 		('imprint HINT' imprintHintOnForm)
+ 		-
+ 		('show initial picture' adoptInitialPicture )
+ 		('show final picture' adoptFinalPicture )
+ 		('show caption' adoptTextualAppearance)
+ 		-
+ 		('change caption' changeCaption)
+ 		('open for editing' openInRecordingSpace)) translatedNoop!

Item was added:
+ ----- Method: PlaybackInvoker>>adoptAsCurrentForm: (in category 'initialization') -----
+ adoptAsCurrentForm: aForm
+ 	"Make the given form my current form."
+ 
+ 	| existing |
+ 	self isFlexed ifTrue: [self removeFlexShell].
+ 
+ 	existing := self topLeft.
+ 	scalePoint := 1 at 1.
+ 
+ 	originalForm := aForm.
+ 	rotatedForm := aForm.
+ 	self extent: aForm extent.
+ 	self topLeft: existing.
+ 
+ 	self layoutChanged!

Item was added:
+ ----- Method: PlaybackInvoker>>adoptFinalPicture (in category 'appearance') -----
+ adoptFinalPicture
+ 	"Adopt a scaled-down version of the final picture as my icon."
+ 
+ 	self installScaledFinalPictureAsIcon!

Item was added:
+ ----- Method: PlaybackInvoker>>adoptInitialPicture (in category 'appearance') -----
+ adoptInitialPicture
+ 	"Adopt a scaled-down version of the initial appearance of the playback theatre as my icon."
+ 	
+ 	self adoptAsCurrentForm: beforeBitmap copy!

Item was added:
+ ----- Method: PlaybackInvoker>>adoptTextualAppearance (in category 'appearance') -----
+ adoptTextualAppearance
+ 	"Make the receiver be a textually-emblazoned button."
+ 
+ 	self showString: self caption
+ 
+ 	!

Item was added:
+ ----- Method: PlaybackInvoker>>appearAtButtonPosition (in category 'menu ') -----
+ appearAtButtonPosition
+ 	"Arrange for playback to appear at the button's position."
+ 
+ 	whereToAppear := #buttonPosition
+ 
+ 	
+ !

Item was added:
+ ----- Method: PlaybackInvoker>>appearAtButtonPositionString (in category 'menu ') -----
+ appearAtButtonPositionString
+ 	"Answer a string telling whether the playback window should appear at the button's position."
+ 
+ 	^ ((whereToAppear = #buttonPosition)
+ 		ifTrue:
+ 			['<yes>']
+ 		ifFalse:
+ 			['<no>']), 'playback at button position' translated!

Item was added:
+ ----- Method: PlaybackInvoker>>appearAtContainerOrigin (in category 'menu ') -----
+ appearAtContainerOrigin
+ 	"Arrange for playback to appear at the the button's contain'er's origin"
+ 
+ 	whereToAppear := #containerOrigin
+ 
+ 	
+ !

Item was added:
+ ----- Method: PlaybackInvoker>>appearAtContainerOriginString (in category 'menu ') -----
+ appearAtContainerOriginString
+ 	"Answer a string telling whether the playback window should appear at the center of the screen."
+ 
+ 	^ ((whereToAppear = #containerOrigin)
+ 		ifTrue:
+ 			['<yes>']
+ 		ifFalse:
+ 			['<no>']), 'playback at container origin' translated!

Item was added:
+ ----- Method: PlaybackInvoker>>appearAtScreenCenter (in category 'menu ') -----
+ appearAtScreenCenter
+ 	"Arrange for playback to appear at the screen center."
+ 
+ 	whereToAppear := #screenCenter
+ 
+ 	
+ !

Item was added:
+ ----- Method: PlaybackInvoker>>appearAtScreenCenterString (in category 'menu ') -----
+ appearAtScreenCenterString
+ 	"Answer a string telling whether the playback window should appear at the center of the screen."
+ 
+ 	^ ((whereToAppear = #screenCenter)
+ 		ifTrue:
+ 			['<yes>']
+ 		ifFalse:
+ 			['<no>']), 'playback at screen center' translated!

Item was added:
+ ----- Method: PlaybackInvoker>>autoDismiss (in category 'accessing') -----
+ autoDismiss
+ 	"Answer whether autoDismiss is in effect."
+ 
+ 	^ autoDismiss = true!

Item was added:
+ ----- Method: PlaybackInvoker>>autoDismissString (in category 'menu ') -----
+ autoDismissString
+ 	"Answer a string telling the status of my autoDismiss."
+ 
+ 	^ (autoDismiss
+ 		ifTrue:
+ 			['<yes>']
+ 		ifFalse:
+ 			['<no>']), 'auto dismiss' translated!

Item was added:
+ ----- Method: PlaybackInvoker>>autoStart (in category 'accessing') -----
+ autoStart
+ 	"Answer whether autoStart is in effect."
+ 
+ 	^ autoStart = true!

Item was added:
+ ----- Method: PlaybackInvoker>>autoStartString (in category 'menu ') -----
+ autoStartString
+ 	"Answer a string telling the status of my autoStart."
+ 
+ 	^ (autoStart
+ 		ifTrue:
+ 			['<yes>']
+ 		ifFalse:
+ 			['<no>']), 'auto start' translated!

Item was added:
+ ----- Method: PlaybackInvoker>>caption (in category 'accessing') -----
+ caption
+ 	"Answer the caption."
+ 
+ 	^ caption!

Item was added:
+ ----- Method: PlaybackInvoker>>changeCaption (in category 'menu ') -----
+ changeCaption
+ 	"Allow the user to edit the caption name for this button.  Create a new button with the new caption."
+ 
+ 	| result interimSpace newButton |
+ 	result := FillInTheBlank request: 'Please edit the caption' translated initialAnswer:  caption.
+ 	result isEmptyOrNil ifTrue: [^ self].
+ 	caption := result.
+ 	interimSpace := EventRecordingSpace new.
+ 	interimSpace initializeFromPlaybackButton: self.
+ 	newButton := PlaybackInvoker new initializeFrom: interimSpace.
+ 	self form: newButton imageForm!

Item was added:
+ ----- Method: PlaybackInvoker>>contentArea (in category 'accessing') -----
+ contentArea
+ 	"Answer the contentArea."
+ 
+ 	^ contentArea!

Item was added:
+ ----- Method: PlaybackInvoker>>defaultNameStemForInstances (in category 'menu ') -----
+ defaultNameStemForInstances
+ 	"Answer a basis for names of default instances of the receiver."
+ 
+ 	^ caption!

Item was added:
+ ----- Method: PlaybackInvoker>>finalPicture (in category 'accessing') -----
+ finalPicture
+ 	"Answer the final picture."
+ 
+ 	^ finalPicture!

Item was added:
+ ----- Method: PlaybackInvoker>>fire (in category 'notification') -----
+ fire
+ 	"Fire the receiver."
+ 
+ 	self launchPlayback!

Item was added:
+ ----- Method: PlaybackInvoker>>imprintHintOnForm (in category 'initialization') -----
+ imprintHintOnForm
+ 	"Make me show HINT imprinted on my before-image"
+ 
+ 	| anOffset scaledHint combinedBitmap |
+ 	self isFlexed ifTrue: [self removeFlexShell].
+ 	scaledHint := self class hintForm scaledToSize: (0.8 * self extent).
+ 	combinedBitmap := self imageForm deepCopy.
+ 	anOffset := (self extent // 2) -  ((scaledHint width // 2) @ 0).
+ 	scaledHint displayOn: combinedBitmap at: anOffset rule:  Form paint.
+ 	self adoptAsCurrentForm: combinedBitmap!

Item was added:
+ ----- Method: PlaybackInvoker>>initialPicture (in category 'accessing') -----
+ initialPicture
+ 	"Answer the initial picture."
+ 
+ 	^ initialPicture!

Item was added:
+ ----- Method: PlaybackInvoker>>initializeFrom: (in category 'initialization') -----
+ initializeFrom: anEventRecordingSpace
+ 	"Initialize the receiver from the given recording space."
+ 
+ 	| beforeImage theatreCopy |
+ 
+ 	theatreCopy := anEventRecordingSpace veryDeepCopy.
+ 	"Still want to do the below but there are still maddening problems with it."
+ 	"theatreCopy convertToCanonicalForm."
+ 
+ 	autoStart := true.
+ 	autoDismiss := true.
+ 
+ 	caption := theatreCopy captionString.
+ 	offeringHint := true.
+ 
+ 	beforeImage := theatreCopy initialPicture.
+ 
+ 	beforeBitmap := beforeImage scaledToSize: (beforeImage extent * 0.3) rounded.
+ 
+ 	theatreCopy rewind.
+ 	contentArea := theatreCopy initialContentArea veryDeepCopy.
+ 	tape := theatreCopy eventRecorder tape veryDeepCopy.
+ 	caption := theatreCopy captionString.
+ 
+ 	theatreCopy balloonHelpString ifNotNilDo:
+ 		[:t | self setBalloonText: t].
+ 
+ 	self form: beforeBitmap.
+ 
+ 	initialPicture := anEventRecordingSpace initialPicture veryDeepCopy.
+ 	finalPicture := anEventRecordingSpace finalPicture veryDeepCopy.
+ 
+ 	postPlaybackImageFeature := false.
+ 
+ 	self on: #mouseUp send: #launchPlayback to: self
+ 
+ 
+ 	!

Item was added:
+ ----- Method: PlaybackInvoker>>installScaledFinalPictureAsIcon (in category 'appearance') -----
+ installScaledFinalPictureAsIcon
+ 	"Like de selector say."
+ 
+ 	self adoptAsCurrentForm: (finalPicture scaledToSize: (finalPicture extent * 0.5) rounded)!

Item was added:
+ ----- Method: PlaybackInvoker>>isLikelyRecipientForMouseOverHalos (in category 'halos and balloon help') -----
+ isLikelyRecipientForMouseOverHalos
+ 	"Nein, danke."
+ 
+ 	^ false!

Item was added:
+ ----- Method: PlaybackInvoker>>launchPlayback (in category 'initialization') -----
+ launchPlayback
+ 	"Launch a playback window."
+ 
+ 	EventPlaybackSpace new launchFrom: self
+ !

Item was added:
+ ----- Method: PlaybackInvoker>>offeringHintString (in category 'menu ') -----
+ offeringHintString
+ 	"Answer a string telling the status of my offeringHint."
+ 
+ 	^ (offeringHint
+ 		ifTrue:
+ 			['<yes>']
+ 		ifFalse:
+ 			['<no>']), 'offering hint'!

Item was added:
+ ----- Method: PlaybackInvoker>>openInRecordingSpace (in category 'menu ') -----
+ openInRecordingSpace
+ 	"Open a new EventRecordingSpace based on the receiver."
+ 
+ 	EventRecordingSpace openFromPlaybackButton: self!

Item was added:
+ ----- Method: PlaybackInvoker>>playbackConcludedIn: (in category 'notification') -----
+ playbackConcludedIn: aPlaybackSpace
+ 	"A playback invoked by the receiver has concluded; if appropriate, change the appearance of the receiver."
+ 
+ 	postPlaybackImageFeature == true ifTrue:
+ 		[self installScaledFinalPictureAsIcon]
+ 	!

Item was added:
+ ----- Method: PlaybackInvoker>>postPlaybackImageFeatureString (in category 'menu ') -----
+ postPlaybackImageFeatureString
+ 	"Answer a string telling whether the playback button should be a 50% rendition of the final bitmap after an invoked playback has ended"
+ 
+ 	^ ((postPlaybackImageFeature = true)
+ 		ifTrue:
+ 			['<yes>']
+ 		ifFalse:
+ 			['<no>']), 'post-playback feature' translated!

Item was added:
+ ----- Method: PlaybackInvoker>>showString: (in category 'appearance') -----
+ showString: aString 
+ 	"Make the receiver show the given string."
+ 
+ 	| str rec |
+ 	str := StringMorph contents: aString font: Preferences standardEToysButtonFont.
+ 
+ 	rec := RectangleMorph new extent: (str extent + (10 at 10)); color:  (Color r: 0.677 g: 0.935 b: 0.484);  borderWidth: 1; yourself.
+ 	rec addMorphBack: str.
+ 	rec useRoundedCorners.
+ 	str center: rec center.
+ 	self form: rec imageForm
+ !

Item was added:
+ ----- Method: PlaybackInvoker>>tape (in category 'accessing') -----
+ tape
+ 	"Answer the tape"
+ 
+ 	^ tape!

Item was added:
+ ----- Method: PlaybackInvoker>>toggleAutoDismiss (in category 'menu ') -----
+ toggleAutoDismiss
+ 	"Toggle my autoDismiss state."
+ 
+ 	autoDismiss := autoDismiss not!

Item was added:
+ ----- Method: PlaybackInvoker>>toggleAutoStart (in category 'menu ') -----
+ toggleAutoStart
+ 	"Toggle my autoStart state."
+ 
+ 	autoStart := autoStart not!

Item was added:
+ ----- Method: PlaybackInvoker>>togglePostPlaybackImageFeature (in category 'menu ') -----
+ togglePostPlaybackImageFeature
+ 	"Toggle the setting of the postPlaybackImage feature."
+ 
+ 	postPlaybackImageFeature := (postPlaybackImageFeature = true) not!

Item was added:
+ ----- Method: PlaybackInvoker>>whereToAppear (in category 'accessing') -----
+ whereToAppear
+ 	"Answer a symbol designating where to appear."
+ 
+ 	whereToAppear ifNil: [whereToAppear := #buttonPosition].
+ 	^ whereToAppear!

Item was changed:
  ----- Method: Player class>>bringScriptsUpToDate (in category 'scripts') -----
  bringScriptsUpToDate
  	"Bring all the receiver's scripts up to date, after, for example, a name change"
  
  	self scripts do:
  		[:aUniclassScript |
+ 			aUniclassScript bringUpToDate.
+ 			aUniclassScript recompileScriptFromTilesUnlessTextuallyCoded]!
- 			aUniclassScript bringUpToDate]!

Item was changed:
  ----- Method: Player class>>compileInstVarAccessorsFor: (in category 'slots') -----
  compileInstVarAccessorsFor: varName
  	"Compile getters and setteres for the given instance variable name"
  
  	| nameString |
  	nameString := varName asString capitalized.
+ 	self compileSilently: ('get{1}
+ 	^ {2}' format: {nameString. varName})
- 	self compileSilently: ('get', nameString, '
- 	^ ', varName)
  		classified: 'access'.
+ 	self compileSilently: ('set{1}: a{1}
+ 	{2} := a{1}' format: {nameString. varName})
- 	self compileSilently: ('set', nameString, ': val
- 	', varName, ' := val')
  		classified: 'access'!

Item was added:
+ ----- Method: Player class>>compilerClass (in category 'compiling') -----
+ compilerClass
+ 
+ 	^ ScriptCompiler!

Item was changed:
  ----- Method: Player class>>createSequencialStubSubclass (in category 'turtles') -----
  createSequencialStubSubclass
  
+ 	^ KedamaSequenceExecutionStub newUniqueClassInstVars: '' classInstVars: ''.
- 	| instVarString classInstVarString aName aClass |
- 	instVarString := KedamaSequenceExecutionStub instVarNames.
- 	classInstVarString := ''.
- 	aName := self chooseUniqueTurtleClassName.
- 	aClass := self subclass: aName instanceVariableNames: instVarString 
- 		classVariableNames: '' poolDictionaries: '' category: self categoryForUniclasses.
- 	classInstVarString size > 0 ifTrue:
- 		[aClass class instanceVariableNames: classInstVarString].
- 	aClass copyAllCategoriesUnobtrusivelyFrom: KedamaSequenceExecutionStub.
- 	^ aClass
  !

Item was added:
+ ----- Method: Player class>>createTurtleSubclass2 (in category '*Etoys-Squeakland-turtles') -----
+ createTurtleSubclass2
+ 
+ 	^ KedamaTurtleVectorPlayer2 newUniqueClassInstVars: '' classInstVars: ''.
+ !

Item was changed:
  ----- Method: Player class>>freeUnreferencedSubclasses (in category 'housekeeping') -----
  freeUnreferencedSubclasses
  	"Player classes may hold in their class instance variables references
  to instances of themselves that are housekeepingwise unreachable. This
  method allows such loops to be garbage collected. This is done in three
  steps:
  	1. Remove user-created subclasses from the 'subclasses' set and from
  Smalltalk. Only remove classes whose name begins with 'Player' and which
  have no references.
  	2. Do a full garbage collection.
  	3. Enumerate all Metaclasses and find those whose soleInstance's
  superclass is this class. Reset the subclasses set to this set of
  classes, and add back to Smalltalk."
  	"Player freeUnreferencedSubclasses"
  
  	| oldFree candidatesForRemoval class |
+ 	oldFree _ Smalltalk garbageCollect.
+ 	candidatesForRemoval _ self subclasses asOrderedCollection select:
- 	oldFree := Smalltalk garbageCollect.
- 	candidatesForRemoval := self subclasses asOrderedCollection select:
  		[:aClass | (aClass name beginsWith: 'Player') and: [aClass name
  endsWithDigit]].
  
  	"Break all system links and then perform garbage collection."
  	candidatesForRemoval do:
  		[:c | self removeSubclass: c.  "Break downward subclass pointers."
+ 		Smalltalk removeKey: c name ifAbsent: [].  "Break binding of global
- 		c environment removeKey: c name ifAbsent: [].  "Break binding of global
  name"].
+ 	candidatesForRemoval _ nil.
- 	candidatesForRemoval := nil.
  	Smalltalk garbageCollect.  "Now this should reclaim all unused
  subclasses"
  
  	"Now reconstruct system links to subclasses with valid references."
  	"First restore any global references via associations"
  	(Association allSubInstances select:
  			[:assn | (assn key isSymbol)
  					and: [(assn key beginsWith: 'Player')
  					and: [assn key endsWithDigit]]])
+ 		do: [:assn | class _ assn value.
- 		do: [:assn | class := assn value.
  			(class isKindOf: self class) ifTrue:
  				[self addSubclass: class.
+ 				Smalltalk add: assn]].
- 				class environment add: assn]].
  	"Then restore any further direct references, creating new
  associations."
  	(Metaclass allInstances select:
  			[:m | (m soleInstance name beginsWith: 'Player')
  					and: [m soleInstance name endsWithDigit]])
+ 		do: [:m | class _ m soleInstance.
+ 			((class isKindOf: self class) and: [(Smalltalk includesKey: class
- 		do: [:m | class := m soleInstance.
- 			((class isKindOf: self class) and: [(class environment includesKey: class
  name) not]) ifTrue:
  				[self addSubclass: class.
+ 				Smalltalk at: class name put: class]].
- 				class environment at: class name put: class]].
  	SystemOrganization removeMissingClasses.
  	^ Smalltalk garbageCollect - oldFree
  !

Item was added:
+ ----- Method: Player class>>isRead: (in category '*Etoys-Squeakland-turtles') -----
+ isRead: aSelector
+ 
+ 	^ (aSelector beginsWith: 'get').
+ !

Item was added:
+ ----- Method: Player class>>isWrite: (in category '*Etoys-Squeakland-turtles') -----
+ isWrite: aSelector
+ 
+ 	^ (aSelector beginsWith: 'set').
+ !

Item was added:
+ ----- Method: Player class>>myProject (in category '*Etoys-Squeakland-other') -----
+ myProject
+ 	"Find the project I was defined in, or nil"
+ 	self isSystemDefined ifTrue: [^nil].
+ 	Project allProjects do: [:prj |
+ 		prj world presenter allExtantPlayers do: [:plr |
+ 			 plr class == self ifTrue: [^prj]]].
+ 	^nil
+ !

Item was added:
+ ----- Method: Player class>>readOrWriteOrNil: (in category '*Etoys-Squeakland-turtles') -----
+ readOrWriteOrNil: aSymbol
+ 
+ 	(self isRead: aSymbol) ifTrue: [^ #read].
+ 	(self isWrite: aSymbol) ifTrue: [^ #write].
+ 	^ nil.
+ !

Item was changed:
+ ----- Method: Player class>>variableDocks (in category 'other') -----
- ----- Method: Player class>>variableDocks (in category 'variable docks') -----
  variableDocks
+ 	"Backward compatibility -- answer the formal list of VariableDocks associated with the class, assuming the class to be a CardPlayer subclass.  Somewhere a long time ago evidently the players assigned to Worlds stopped being CardPlayers, so this method is now provided as a backstop."
- 	"Answer the list of variable docks in the receiver.  Initialize the variable-dock list if not already done."
  
+ 	^ #()!
- 	variableDocks ifNil: [variableDocks := OrderedCollection new].
- 	^ variableDocks!

Item was changed:
  ----- Method: Player>>acceptScript:for: (in category 'scripts-kernel') -----
  acceptScript: aScriptEditorMorph for: aSelector
  	"Accept the tile code in the script editor as the code for the given selector.  This branch is only for the classic-tile system, 1997-2001"
  
+ 	| aUniclassScript node |
+ 	aScriptEditorMorph generateParseNodeDirectly ifTrue: [
+ 		(node _ aScriptEditorMorph methodNode) ifNotNil: [
+ 			self class addSelectorSilently: aScriptEditorMorph scriptName withMethod: (node generate: CompiledMethodTrailer empty).
+ 			SystemChangeNotifier uniqueInstance doSilently: [self class organization classify: aSelector under: 'scripts']
+ 		].
+ 	] ifFalse: [
+ 		self class compileSilently: aScriptEditorMorph methodString
+ 			classified: 'scripts' for: self.
+ 	].
+ 	aUniclassScript _ self class assuredMethodInterfaceFor: aSelector asSymbol.
+ 	aUniclassScript currentScriptEditor: aScriptEditorMorph.
+ 	aScriptEditorMorph world ifNotNil: [aScriptEditorMorph world removeHighlightFeedback].
+ !
- 	| aUniclassScript |
- 	self class compileSilently: aScriptEditorMorph methodString
- 		classified: 'scripts'.
- 	aUniclassScript := self class assuredMethodInterfaceFor: aSelector asSymbol.
- 	aUniclassScript currentScriptEditor: aScriptEditorMorph!

Item was changed:
  ----- Method: Player>>acceptableScriptNameFrom:forScriptCurrentlyNamed: (in category 'scripts-kernel') -----
  acceptableScriptNameFrom: originalString forScriptCurrentlyNamed: currentName
  	"Produce an acceptable script name, derived from the current name, for the receiver.  This method will always return a valid script name that will be suitable for use in the given situation, though you might not like its beauty sometimes."
  
  	| aString stemAndSuffix proscribed stem suffix withoutColon currentNumArgs withColon |
+ 	withoutColon _ originalString withFirstCharacterDownshifted copyWithoutAll: {$:. $ }.
- 	withoutColon := originalString copyWithoutAll: {$:. $ }.
  	(currentName notNil and: [(currentName copyWithout: $:) = withoutColon])
  		ifTrue:
  			[^ currentName].  "viz. no change; otherwise, the #respondsTo: check gets in the way"
  
+ 	currentNumArgs _ currentName ifNil: [0] ifNotNil: [currentName numArgs].
+ 	aString _ withoutColon asIdentifier: false.  "get an identifier starting with a lowercase letter"
+ 	stemAndSuffix _ aString stemAndNumericSuffix.
+ 	proscribed _ #(self super thisContext costume costumes dependents #true #false size).
- 	currentNumArgs := currentName ifNil: [0] ifNotNil: [currentName numArgs].
- 	aString := withoutColon asIdentifier: false.  "get an identifier starting with a lowercase letter"
- 	stemAndSuffix := aString stemAndNumericSuffix.
- 	proscribed := #(self super thisContext costume costumes dependents #true #false size).
  
+ 	stem _ stemAndSuffix first.
+ 	suffix _ stemAndSuffix last.
+ 	withoutColon _ aString asSymbol.
+ 	withColon _ (withoutColon, ':') asSymbol.
- 	stem := stemAndSuffix first.
- 	suffix := stemAndSuffix last.
- 	withoutColon := aString asSymbol.
- 	withColon := (withoutColon, ':') asSymbol.
  
  	[(proscribed includes: withoutColon)
+ 		or: [self respondsTo: withoutColon]
+ 		or: [self respondsTo: withColon]
+ 		or:	[Smalltalk includesKey: withoutColon]
+ 		or: [Smalltalk includesKey: withColon]]
- 		or: [(self respondsTo: withoutColon)
- 		or: [(self respondsTo: withColon)
- 		or:	[(Smalltalk includesKey: withoutColon)
- 		or: [(Smalltalk includesKey: withColon)]]]]]
  	whileTrue:
+ 		[suffix _ suffix + 1.
+ 		withoutColon _ (stem, suffix printString) asSymbol.
+ 		withColon _ (withoutColon, ':') asSymbol].
- 		[suffix := suffix + 1.
- 		withoutColon := (stem, suffix printString) asSymbol.
- 		withColon := (withoutColon, ':') asSymbol].
  
  	^ currentNumArgs = 0
  		ifTrue:
  			[withoutColon]
  		ifFalse:
  			[withColon]!

Item was changed:
  ----- Method: Player>>addIdiosyncraticMenuItemsTo:forSlotSymol: (in category 'scripts-kernel') -----
  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 == #penTrailGraphic) ifTrue:
+ 		[aMenu add: 'hand me a picture of pen trail' translated action: #handUserPictureOfPenTrail].
+ 
  "	(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]."
  !

Item was changed:
  ----- Method: Player>>addInstanceVariable (in category 'slots-user') -----
  addInstanceVariable
  	"Offer the user the opportunity to add an instance variable, and if he goes through with it, actually add it."
+ 	ActiveWorld 
+ 		addMorphInLayer: (NewVariableDialogMorph on: self costume)
+ 		centeredNear: (ActiveHand ifNil:[Sensor]) cursorPoint!
- 
- 	| itsName initialValue typeChosen usedNames initialAnswer setterSelector originalString |
- 	usedNames := self class instVarNames.
- 
- 	initialAnswer := Utilities keyLike: ('var' translated, (usedNames size + 1) asString)  satisfying: [:aKey | (usedNames includes: aKey) not].
- 
- 	originalString := UIManager default request: 'name for new variable: ' translated initialAnswer: initialAnswer.
- 	originalString isEmptyOrNil ifTrue: [^ self].
- 	itsName := ScriptingSystem acceptableSlotNameFrom: originalString forSlotCurrentlyNamed: nil asSlotNameIn: self world: self costume world.
- 
-  	itsName size = 0 ifTrue: [^ self].	
- 	self assureUniClass.
- 	typeChosen := self initialTypeForSlotNamed: itsName.
- 	self slotInfo at: itsName put: (SlotInformation new initialize type: typeChosen).
- 	initialValue := self initialValueForSlotOfType: typeChosen.
- 	self addInstanceVarNamed: itsName withValue: initialValue.
- 	self compileInstVarAccessorsFor: itsName.
- 	setterSelector := itsName asSetterSelector.
- 	((self class allSubInstances copyWithout: self) reject: [:e | e isSequentialStub]) do:
- 		[:anInstance | anInstance perform: setterSelector with: initialValue].
- 	self updateAllViewersAndForceToShow: ScriptingSystem nameForInstanceVariablesCategory!

Item was changed:
  ----- Method: Player>>adoptScriptsFrom (in category 'misc') -----
  adoptScriptsFrom
  	"Let the user click on another object form which the receiver should obtain scripts and code"
  
  	| aMorph |
  	Sensor waitNoButton.
+ 	aMorph _ ActiveWorld chooseClickTarget.
- 	aMorph := ActiveWorld chooseClickTarget.
  	aMorph ifNil: [^ Beeper beep].
  
+ 	(((aMorph renderedMorph isSketchMorph) and: [aMorph player belongsToUniClass]) and: [self belongsToUniClass not])
- 	(((aMorph isSketchMorph) and: [aMorph player belongsToUniClass]) and: [self belongsToUniClass not])
  		ifTrue:
  			[costume acquirePlayerSimilarTo: aMorph player]
  		ifFalse:
  			[Beeper beep]!

Item was changed:
  ----- Method: Player>>allScriptEditors (in category 'scripts-kernel') -----
  allScriptEditors
  	"Used presently only an one-shot efforts to update all tile scripts to new styles"
  
+ 	^ self class tileScriptNames collect: [:n | self scriptEditorForNoCng: n]!
- 	^ self class tileScriptNames collect: [:n | self scriptEditorFor: n]!

Item was changed:
  ----- Method: Player>>append: (in category 'scripts-standard') -----
  append: aPlayer 
  	"Add aPlayer to the list of objects logically 'within' me.  This is visually represented by its morph becoming my costume's last submorph.   Also allow text to be appended."
  
  	| aCostume |
  	(aPlayer isNil or: [aPlayer == self]) ifTrue: [^self].
  	(aPlayer isText or: [aPlayer isString]) 
  		ifTrue: 
  			[self costume class == TextFieldMorph 
  				ifTrue: [^self costume append: aPlayer]
  				ifFalse: [^self]].
  	(aCostume := self costume topRendererOrSelf) 
  		addMorphNearBack: aPlayer costume.
  	aPlayer costume goHome.	"assure it's in view"
  	(aCostume isKindOf: PasteUpMorph) 
+ 		ifTrue: [self setCursor: (aCostume submorphs indexOf: aPlayer costume).
+ 				aCostume 	 updateSubmorphThumbnails]  "also forces redraw"!
- 		ifTrue: [self setCursor: (aCostume submorphs indexOf: aPlayer costume)]!

Item was added:
+ ----- Method: Player>>appendCharacters: (in category '*Etoys-Squeakland-scripts-standard') -----
+ appendCharacters: aString
+ 	"append the characters from the given player to my end"
+ 
+ 	self costume renderedMorph appendCharacters: aString!

Item was added:
+ ----- Method: Player>>appendVertex (in category '*Etoys-Squeakland-vertices operation') -----
+ appendVertex
+ 
+ 	self costume appendVertex!

Item was added:
+ ----- Method: Player>>attachTo: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ attachTo: aPlayer
+ self sendMessageToCostume: #target: with: aPlayer costume renderedMorph
+ !

Item was added:
+ ----- Method: Player>>basicBeNotZero: (in category '*Etoys-Squeakland-misc') -----
+ basicBeNotZero: aNumber
+ 	"This is a runtime check if the arg to divide in a script is zero.  If it is, put up a warning message.  Return 0.001 instead of 0.  Note the time.  If fails again within 1 min., don't tell the user again."
+ 
+ 	aNumber = 0 ifFalse: [^ aNumber].	"normal case"
+ 	"We have a problem"
+ 	TimeOfError 
+ 		ifNil: [TimeOfError _ Time totalSeconds]
+ 		ifNotNil: [(Time totalSeconds - TimeOfError) > 45 ifTrue: [
+ 			TimeOfError _ Time totalSeconds.	"in case user interrupt and reenter"
+ 			self inform: 
+ 'Dividing by zero makes a number too
+ large for even a Sorcerer to handle.
+ Please change your script.' translated.
+ 			TimeOfError _ Time totalSeconds]].
+ 	^ 0.001!

Item was changed:
  ----- Method: Player>>basicRenameSlot:newSlotName: (in category 'slots-user') -----
  basicRenameSlot: oldSlotName newSlotName: newSlotName
  	"Give an existing instance variable a new name"
  
  	self class renameSilentlyInstVar: oldSlotName to: newSlotName.
  	self renameSlotInWatchersOld: oldSlotName new: newSlotName.
+ 	self regenerateScripts.
  
  	self updateAllViewers.
  
  	self presenter allExtantPlayers do:
  		[:aPlayer | (aPlayer hasScriptReferencing: oldSlotName ofPlayer: self)
  			ifTrue:
  				[aPlayer noteRenameOf: oldSlotName to: newSlotName inPlayer: self]].
  
  	self presenter hasAnyTextuallyCodedScripts
  		ifTrue:
  			[self inform: 
+ 'Caution!!  References in textually-coded scripts won''t be renamed.' translated].
- 'Caution!!  References in texutally coded scripts won''t be renamed.'].
  
  	^ true!

Item was changed:
  ----- Method: Player>>beNotZero: (in category 'misc') -----
+ beNotZero: value
- beNotZero: aNumber
  	"This is a runtime check if the arg to divide in a script is zero.  If it is, put up a warning message.  Return 0.001 instead of 0.  Note the time.  If fails again within 1 min., don't tell the user again."
  
+ 	| ret v result |
+ 	value isNumber ifTrue: [^ self basicBeNotZero: value].
+ 	ret _ KedamaFloatArray new: value size.
+ 	1 to: value size do: [:i |
+ 		v _ value at: i.
+ 		v = 0 ifFalse: [result _ v].
+ 		"We have a problem"
+ 		TimeOfError 
+ 			ifNil: [TimeOfError _ Time totalSeconds]
+ 			ifNotNil: [(Time totalSeconds - TimeOfError) > 45 ifTrue: [
+ 				TimeOfError _ Time totalSeconds.	"in case user interrupt and reenter"
+ 				self inform: 
+ 				'Dividing by zero makes a number too
+ 				large for even a Sorcerer to handle.
+ 				Please change your script.' translated.
+ 				TimeOfError _ Time totalSeconds]].
+ 		result _ 0.001.
+ 		ret at: i put: result.
+ 	].
+ 	^ ret.
+ !
- 	aNumber = 0 ifFalse: [^ aNumber].	"normal case"
- 	"We have a problem"
- 	TimeOfError 
- 		ifNil: [TimeOfError := Time totalSeconds]
- 		ifNotNil: [(Time totalSeconds - TimeOfError) > 45 ifTrue: [
- 			TimeOfError := Time totalSeconds.	"in case user interrupt and reenter"
- 			self inform: 
- 'Dividing by zero makes a number too
- large for even a Sorcerer to handle.
- Please change your script.' translated.
- 			TimeOfError := Time totalSeconds]].
- 	^ 0.001!

Item was added:
+ ----- Method: Player>>bearingFrom: (in category '*Etoys-Squeakland-special numeric slots') -----
+ bearingFrom: aPlayer
+ 	"Answer the bearing to the receiver from another player"
+ 
+ 	^ (aPlayer costume referencePositionInWorld bearingToPoint: costume referencePositionInWorld) asSmallAngleDegrees!

Item was added:
+ ----- Method: Player>>bearingTo: (in category '*Etoys-Squeakland-special numeric slots') -----
+ bearingTo: aPlayer
+ 	"Answer the bearing from the receiver to another player."
+ 
+ 	^ (costume referencePositionInWorld bearingToPoint: aPlayer costume referencePositionInWorld) asSmallAngleDegrees!

Item was changed:
+ ----- Method: Player>>beep: (in category 'slots-user') -----
+ beep: anObject
- ----- Method: Player>>beep: (in category 'misc') -----
- beep: soundName
  	"Play given sound or at least beep."
  
+ 	| sound |
+ 	anObject isString
+ 		ifTrue:
+ 			[sound := SoundService default playSoundNamedOrBeep: anObject.
+ 			(sound respondsTo: #stopGracefully)
+ 				ifTrue: [self costume setProperty: #sound toValue: anObject.
+ 							self costume setProperty: #playingSound toValue: sound]]
+ 		ifFalse:
+ 			[SoundPlayer resumePlaying: anObject quickStart: true]
- 	SoundService default playSoundNamedOrBeep: soundName
  !

Item was changed:
  ----- Method: Player>>categoriesForVocabulary: (in category 'slots-kernel') -----
  categoriesForVocabulary: aVocabulary
  	"Answer a list of categories appropriate to the receiver and its costumes, in the given Vocabulary"
  
+ 	| aList scriptsName |
- 	| aList |
  	self hasCostumeThatIsAWorld
  		ifTrue:
+ 			[aList _ self categoriesForWorld]
- 			[aList := self categoriesForWorld]
  		ifFalse:
+ 			[aList _ OrderedCollection new.
- 			[aList := OrderedCollection new.
  			self slotNames ifNotEmpty:
  				[aList add: ScriptingSystem nameForInstanceVariablesCategory].
  			aList addAll: costume categoriesForViewer].
  	aVocabulary addCustomCategoriesTo: aList.
  	aList remove: ScriptingSystem nameForScriptsCategory ifAbsent: [].
+ 	scriptsName _ ScriptingSystem nameForScriptsCategory.
+ 	aList size > 2 ifTrue: [
+ 		aList add: scriptsName after: aList first.
+ 	] ifFalse: [
+ 		aList addLast: scriptsName.
+ 	].
- 	aList add: ScriptingSystem nameForScriptsCategory after: aList first.
  	^ aList!

Item was changed:
  ----- Method: Player>>categoriesForWorld (in category 'slots-kernel') -----
  categoriesForWorld
  	"Answer the list of categories given that the receiver is the Player representing a World"
  
  	| aList |
+ 	aList _ #(color #'fill & border' scripting #'pen trails' #'world geometry' playfield collections sound) asOrderedCollection.
- 	aList := #(#'color & border' #geometry #'pen trails' playfield collections #'stack navigation') asOrderedCollection.
- 	aList addFirst: ScriptingSystem nameForScriptsCategory.
- 	aList addFirst: ScriptingSystem nameForInstanceVariablesCategory.
  	aList add: #input.
  	Preferences eToyFriendly ifFalse:
+ 		[aList addAll: #(preferences #'as object'  
+ display) ].
- 		[aList add: #preferences].
  
+ 	aList addAll: {ScriptingSystem nameForInstanceVariablesCategory.  ScriptingSystem nameForScriptsCategory}.
+ 
  	^ aList!

Item was changed:
  ----- Method: Player>>changeParameterTypeFor: (in category 'costume') -----
  changeParameterTypeFor: aSelector
  	"Change the parameter type for the given selector.  Not currently sent, since types are now set by direct manipulation in the Scriptor header.  If this were reinstated someday, there would probably be an issue about getting correct-looking Parameter tile(s) into the Scriptor header(s)"
  
  	| current typeChoices typeChosen |
+ 	current _ self typeforParameterFor: aSelector.
+ 	typeChoices _ Vocabulary typeChoicesForUserVariables.
+ 	typeChosen _ (SelectionMenu selections: typeChoices lines: #()) startUpWithCaption: 
+ 		('Choose the TYPE
+ for the parameter (currently {1})' translated format: {current}).
- 	current := self typeforParameterFor: aSelector.
- 	typeChoices := Vocabulary typeChoices.
- 	typeChosen := UIManager default 
- 		chooseFrom: typeChoices 
- 		values: typeChoices  
- 		title: ('Choose the TYPE
- for the parameter (currently ', current, ')').
  	self setParameterFor: aSelector toType: typeChosen
  
  !

Item was added:
+ ----- Method: Player>>changeSlotInfo: (in category '*Etoys-Squeakland-slots-user') -----
+ changeSlotInfo: aByteSymbol 
+ 	ActiveWorld 
+ 		addMorphInLayer: (ModifyVariableDialogMorph on: self costume slot: aByteSymbol)
+ 		centeredNear: (ActiveHand ifNil:[Sensor]) cursorPoint!

Item was added:
+ ----- Method: Player>>changeSlotTypeOf:to: (in category '*Etoys-Squeakland-slots-user') -----
+ changeSlotTypeOf: slotName to: newType
+ 	(self typeForSlot: slotName) capitalized = newType ifTrue: [^ self].
+ 
+ 	(self slotInfoAt: slotName) type: newType.
+ 	self class allInstancesDo:   "allSubInstancesDo:"
+ 		[:anInst | anInst instVarNamed: slotName asString put: 
+ 			(anInst valueOfType: newType from: (anInst instVarNamed: slotName))].
+ 	self updateAllViewers.	"does siblings too"
+ 	self changeTypesInWatchersOf: slotName.  "does siblings too"
+ 	
+ !

Item was changed:
  ----- Method: Player>>chooseUserSlot (in category 'slots-user') -----
  chooseUserSlot
+ 	| names aMenu result |
+ 	(names _ self slotNames) size == 1
- 	| names result |
- 	(names := self slotNames) size = 1
  		ifTrue: [^ names first].
+ 	aMenu _ SelectionMenu selections: names.
+ 	result _ aMenu startUpWithCaption: 'Please choose a variable' translated.
- 	result := UIManager default 
- 		chooseFrom: names 
- 		values: names 
- 		title: 'Please choose a variable'.
  	result isEmptyOrNil ifTrue: [^ nil].
  	^ result!

Item was changed:
  ----- Method: Player>>defaultPatchPlayer (in category 'slot-kedama') -----
  defaultPatchPlayer
  
+ 	^ costume renderedMorph kedamaWorld defaultPatch player.
- 	^ costume renderedMorph kedamaWorld player getPatch.
  !

Item was added:
+ ----- Method: Player>>defaultScriptName (in category '*Etoys-Squeakland-misc') -----
+ defaultScriptName
+ 	^'script' translated asLegalSelector!

Item was added:
+ ----- Method: Player>>destroyAllScripts (in category '*Etoys-Squeakland-scripts-kernel') -----
+ destroyAllScripts
+ 	"Destroy all the scripts belonging to the receiver."
+ 
+ 	| sels |
+ 	self class isUniClass ifFalse: [^ self].
+ 
+ 	Cursor wait showWhile:
+ 		[sels := self class scripts collect: [:s | s selector].
+ 		sels do:
+ 			[:aSel | self removeScriptWithSelector: aSel]]
+ 	!

Item was added:
+ ----- Method: Player>>distanceToPlayer: (in category '*Etoys-Squeakland-special numeric slots') -----
+ distanceToPlayer: aPlayer
+ 	"Simplified distance... simply answer the distance between the reference positions of the two objects."
+ 
+ 	^ costume referencePositionInWorld dist: aPlayer costume referencePositionInWorld!

Item was added:
+ ----- Method: Player>>emptyTrashCan (in category '*Etoys-Squeakland-playing commands') -----
+ emptyTrashCan
+ 
+ 	Utilities emptyScrapsBookGC.
+ !

Item was changed:
  ----- Method: Player>>erase (in category 'misc') -----
  erase
+ 	"Simply dismiss the receiver from the screen."
- 	"Dismiss the receiver from the screen.  It can subsequently be found in the trash if need be, provided the preserveTrash preference is set to true"
  
+ 	self costume topRendererOrSelf dismissMorph!
- 	self costume topRendererOrSelf dismissViaHalo!

Item was added:
+ ----- Method: Player>>fitPlayfield (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ fitPlayfield
+ 	"For number-lines:  command to extend/contract the line so that it fits entirely within the containing playfield to which it pertains."
+ 
+ 	costume fitPlayfield!

Item was added:
+ ----- Method: Player>>flipLeftRight (in category '*Etoys-Squeakland-costume') -----
+ flipLeftRight
+ 	self costume renderedMorph allMorphsDo: [ :m |
+ 		m isSketchMorph ifTrue: [m flipHorizontal]]!

Item was added:
+ ----- Method: Player>>flipUpDown (in category '*Etoys-Squeakland-costume') -----
+ flipUpDown
+ 	self costume renderedMorph allMorphsDo: [ :m |
+ 		m isSketchMorph ifTrue: [m flipVertical]]!

Item was changed:
  ----- Method: Player>>followPath (in category 'scripts-standard') -----
  followPath
  	"If there is a path defined for this object, follow it now"
  
+ 	self costume renderedMorph followPath!
- 	self costume followPath!

Item was added:
+ ----- Method: Player>>forceAxisToX: (in category '*Etoys-Squeakland-slots-bonus for geometry') -----
+ forceAxisToX: aNumber
+ 
+ 	self setRotationCenter: aNumber @ self getRotationCenterY!

Item was added:
+ ----- Method: Player>>forceAxisToY: (in category '*Etoys-Squeakland-slots-bonus for geometry') -----
+ forceAxisToY: aNumber
+ 
+ 	self setRotationCenter: self getRotationCenterX @ aNumber!

Item was added:
+ ----- Method: Player>>getAttachment (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ getAttachment
+ 	^ [(self sendMessageToCostume: #target) assuredPlayer]
+ 		on: Error
+ 		do: [self presenter standardPlayer] !

Item was added:
+ ----- Method: Player>>getAttachmentEdge (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getAttachmentEdge
+ 	"Answer the attachment edge, a point."
+ 
+ 	^ costume renderedMorph attachmentEdge!

Item was added:
+ ----- Method: Player>>getAttachmentOffset (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getAttachmentOffset
+ 	"Answer the attachment offset, a point."
+ 
+ 	^ costume renderedMorph attachmentOffset!

Item was added:
+ ----- Method: Player>>getBlue (in category '*Etoys-Squeakland-slots-color components') -----
+ getBlue
+ 	^ self getColor blue * 100!

Item was added:
+ ----- Method: Player>>getBlur (in category '*Etoys-Squeakland-sketch filters') -----
+ getBlur
+ 	^ self getFilterValue: #blur:form:!

Item was added:
+ ----- Method: Player>>getBrightness (in category '*Etoys-Squeakland-slots-color components') -----
+ getBrightness
+ 	^ self getColor brightness * 100!

Item was added:
+ ----- Method: Player>>getBrightnessShift (in category '*Etoys-Squeakland-sketch filters') -----
+ getBrightnessShift
+ 	^ self getFilterValue: #brightnessShift:form:!

Item was added:
+ ----- Method: Player>>getBubble (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ getBubble
+ ^[self costume renderedMorph bubble assuredPlayer] on: Error do: [self presenter standardPlayer]!

Item was added:
+ ----- Method: Player>>getClassName (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getClassName
+ 	"Answer the name of the class"
+ 
+ 	^ self class name asString!

Item was changed:
  ----- Method: Player>>getColor (in category 'slot getters/setters') -----
  getColor
  	"Answer the color of my costume.  If it uses a gradient fill, answer the first color."
  
  	| aFillStyle aMorph |
+ 	^ ((self isFillStyle: (aFillStyle :=  (aMorph := self costume renderedMorph) fillStyle)) and: [aFillStyle isGradientFill] )
- 	^ (aFillStyle := (aMorph := self costume renderedMorph) fillStyle) isGradientFill
  		ifTrue:
  			[aFillStyle colorRamp first value]
  		ifFalse:
  			[aMorph color]!

Item was added:
+ ----- Method: Player>>getCurrentKey (in category '*Etoys-Squeakland-etoys-input') -----
+ getCurrentKey
+ 	^ self sendMessageToCostume: #currentKey!

Item was added:
+ ----- Method: Player>>getDate (in category '*Etoys-Squeakland-etoys-calendar') -----
+ getDate
+ 	"Answer a string representing the selected date."
+ 
+ 	| format |
+ 	format := self getDateFormat caseOf: {
+ 		[#'dd/mm/yyyy'] -> [#(1 2 3 $/ 1 1)].
+ 		[#'yyyy/mm/dd'] -> [#(3 2 1 $/ 1 1)].
+ 		[#'mm/dd/yyyy'] -> [#(2 1 3 $/ 1 1)].
+ 		} otherwise: [#(1 2 3 $  3 1 )].
+ 
+ 	^ self costume renderedMorph date printFormat: format!

Item was added:
+ ----- Method: Player>>getDateFormat (in category '*Etoys-Squeakland-etoys-calendar') -----
+ getDateFormat
+ 	^ self costume renderedMorph valueOfProperty: #dateFormat ifAbsent: [#'mm/dd/yyyy'].!

Item was added:
+ ----- Method: Player>>getDay (in category '*Etoys-Squeakland-etoys-calendar') -----
+ getDay
+ 	"Answer the day-of-month of the selcted day."
+ 
+ 	^self costume renderedMorph date dayOfMonth!

Item was added:
+ ----- Method: Player>>getDayName (in category '*Etoys-Squeakland-etoys-calendar') -----
+ getDayName
+ 	"Answer the day-of-week (e.g. 'Monday') of the selected day."
+ 
+ 	^ self costume renderedMorph date weekday asString translated!

Item was added:
+ ----- Method: Player>>getFilterValue: (in category '*Etoys-Squeakland-sketch filters') -----
+ getFilterValue: aFilter
+ 	self costume renderedMorph isSketchMorph ifFalse:[^0].
+ 	 self costume renderedMorph filters
+ 		do: [:i | (i includes: aFilter)
+ 				ifTrue: [^i second]].
+ 	^0!

Item was changed:
  ----- Method: Player>>getFirstElement (in category 'slot getters/setters') -----
  getFirstElement
+ 	"Answer a player representing the receiver's costume's first submorph.  The costume is assumed to be some kind of PasteUpMorph.  In case it currently is empty, answer the Dot object as a place-holder."
- 	"Answer a player representing the receiver's costume's first submorph"
  
  	| itsMorphs |
+ 	^ (itsMorphs := costume renderedMorph submorphs) notEmpty 
- 	^(itsMorphs := costume submorphs) notEmpty 
  		ifFalse: [costume presenter standardPlayer]
  		ifTrue: [itsMorphs first assuredPlayer]!

Item was added:
+ ----- Method: Player>>getFishEye (in category '*Etoys-Squeakland-sketch filters') -----
+ getFishEye
+ 	^ self getFilterValue: #fishEye:form:!

Item was added:
+ ----- Method: Player>>getFlashCursor (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getFlashCursor
+ 	"Obtain the cursor setting from a FlashPlayerMorph.  Given a separate getter so that it can have a separate entry in the vocabulary's dictionary of methodInterfaces."
+ 
+ 	^ self getCursor!

Item was added:
+ ----- Method: Player>>getForwardDirection (in category '*Etoys-Squeakland-slots-bonus for geometry') -----
+ getForwardDirection
+ 
+ 	^ self costume forwardDirection!

Item was added:
+ ----- Method: Player>>getGifPlaying (in category '*Etoys-Squeakland-MorphicExtras-AdditionalMorphs') -----
+ getGifPlaying
+ 	^self getValueFromCostume: #isStepping!

Item was added:
+ ----- Method: Player>>getGraphCursor (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getGraphCursor
+ 	"Obtain the cursor setting from a FlashPlayerMorph.  Given a separate getter so that it can have a separate entry in the vocabulary's dictionary of methodInterfaces."
+ 
+ 	^ self getCursor!

Item was changed:
  ----- Method: Player>>getGraphic (in category 'slot getters/setters') -----
  getGraphic
  	"Answer a form representing the receiver's primary graphic"
  
  	| aMorph |
+ 	^ ((aMorph _ costume renderedMorph) isSketchMorph)
- 	^ ((aMorph := costume renderedMorph) isSketchMorph)
  		ifTrue:
+ 			[aMorph topRendererOrSelf imageForm]
- 			[aMorph form]
  		ifFalse:
  			[aMorph isPlayfieldLike
  				ifTrue:
  					[aMorph backgroundForm]
  				ifFalse:
  					[aMorph imageForm]]!

Item was changed:
  ----- Method: Player>>getGraphicAtCursor (in category 'slot getters/setters') -----
  getGraphicAtCursor
+ 	"Answer a form depicting the object at the current cursor"
- 	"Answer the form representing the object at the current cursor"
  
  	| anObject aMorph |
  	
+ 	anObject _ self getValueFromCostume: #valueAtCursor.
+ 
+ 	^ (anObject isNil or: [anObject == 0  "weird return from GraphMorph"])
- 	anObject := self getValueFromCostume: #valueAtCursor.
- 	^ anObject == 0  "weird return from GraphMorph"
  		ifTrue:
  			[ScriptingSystem formAtKey: #Paint]
  		ifFalse:
+ 			[((aMorph _ anObject renderedMorph) isSketchMorph)
- 			[((aMorph := anObject renderedMorph) isSketchMorph)
  				ifTrue:
  					[aMorph form]
  				ifFalse:
  					[aMorph isPlayfieldLike
  						ifTrue:
  							[aMorph backgroundForm]
  						ifFalse:
  							[aMorph imageForm]]]!

Item was added:
+ ----- Method: Player>>getGreen (in category '*Etoys-Squeakland-slots-color components') -----
+ getGreen
+ 	^ self getColor green * 100!

Item was added:
+ ----- Method: Player>>getHasPenTrails (in category '*Etoys-Squeakland-pen') -----
+ getHasPenTrails
+ 	"Answer whether the receiver has any pen trails."
+ 
+ 	^ self costume renderedMorph hasPenTrails!

Item was added:
+ ----- Method: Player>>getHash (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getHash
+ 	"Answer the receiver's hash"
+ 
+ 	^ self hash!

Item was added:
+ ----- Method: Player>>getHighlightColor (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getHighlightColor
+ 	"Answer the value of the costume's highlightColor."
+ 
+ 	^ costume highlightColor
+ !

Item was added:
+ ----- Method: Player>>getHue (in category '*Etoys-Squeakland-slots-color components') -----
+ getHue
+ 	| hue |
+ 	hue := self getColor hue.
+ 	^ hue > 180
+ 		ifTrue: [-360 + hue]
+ 		ifFalse: [hue]!

Item was added:
+ ----- Method: Player>>getHueShift (in category '*Etoys-Squeakland-sketch filters') -----
+ getHueShift
+ 	^ self getFilterValue: #hueShift:form:!

Item was added:
+ ----- Method: Player>>getImplicitSelfInTiles (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getImplicitSelfInTiles
+ 	"Getter for the #implicitSelfInTiles preference."
+ 
+ 	^ Preferences implicitSelfInTiles!

Item was added:
+ ----- Method: Player>>getJulianDay (in category '*Etoys-Squeakland-etoys-calendar') -----
+ getJulianDay
+ 	"Answer the julian day of the corresponding calendar's selected date."
+ 
+ 	^ self costume renderedMorph date asJulianDayNumber!

Item was added:
+ ----- Method: Player>>getKeyIsPressed (in category '*Etoys-Squeakland-etoys-input') -----
+ getKeyIsPressed
+ 	^ self sendMessageToCostume: #isPressed!

Item was changed:
  ----- Method: Player>>getLastKeystroke (in category 'slot getters/setters') -----
  getLastKeystroke
  	"Answer the last keystroke fielded"
  
+ 	^ ActiveWorld lastKeystroke!
- 	^ self getValueFromCostume: #lastKeystroke!

Item was added:
+ ----- Method: Player>>getLineCurved (in category '*Etoys-Squeakland-vertices operation') -----
+ getLineCurved
+ 
+ 	^ self costume isCurve!

Item was added:
+ ----- Method: Player>>getLineOpened (in category '*Etoys-Squeakland-vertices operation') -----
+ getLineOpened
+ 
+ 	^ self costume isOpen!

Item was added:
+ ----- Method: Player>>getLocation (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getLocation
+ 	"Answer the object's location.  At the time of publication, the #getLocationRounded variant is the one actually in use."
+ 
+ 	^ self getX @ self getY!

Item was added:
+ ----- Method: Player>>getLocationOnGraph (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ getLocationOnGraph
+ 		"Answer the x-y with respect to a corresponding  axis, if any; if none, for a dimension, use the simple x or y coordinate for it."
+ 
+ 	^ (self getXOnGraph @ self getYOnGraph) asFloatPoint!

Item was added:
+ ----- Method: Player>>getLocationRounded (in category '*Etoys-Squeakland-points') -----
+ getLocationRounded
+ 	"Answer the object's location, rounded for ease of display in a viewer"
+ 
+ 	^ (self getX @ self getY) rounded!

Item was added:
+ ----- Method: Player>>getMagnification (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getMagnification
+ 	"Answer the bottom coordinate, in the cartesian sense (decreases towards bottom of screen)"
+ 
+ 	^ self costume renderedMorph magnification!

Item was added:
+ ----- Method: Player>>getMarksPerLegend (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ getMarksPerLegend
+ 	^ 	self getValueFromCostume: #marksPerLegend!

Item was added:
+ ----- Method: Player>>getMonth (in category '*Etoys-Squeakland-etoys-calendar') -----
+ getMonth
+ 	"Answer the month-number of the selected month."
+ 
+ 	^ self costume renderedMorph date monthIndex!

Item was added:
+ ----- Method: Player>>getMonthName (in category '*Etoys-Squeakland-etoys-calendar') -----
+ getMonthName
+ 	"Answer the month name, e.g. 'Oktober', of the selected month, in the local language."
+ 
+ 	^ self costume renderedMorph date monthName asString translated!

Item was changed:
  ----- Method: Player>>getNewClone (in category 'slot getters/setters') -----
  getNewClone
  	"Answer a new player of the same class as the receiver, with a costume much like mine"
  
  	| clone |
+ 	clone _  costume usableSiblingInstance.
+ 	costume pasteUpMorph ifNotNilDo: [:parent | parent addMorph: clone].
- 	clone :=  costume usableSiblingInstance.
- 	costume pasteUpMorph ifNotNil: [:parent | parent addMorph: clone].
  	^ clone player
  !

Item was changed:
  ----- Method: Player>>getNumberAtCursor (in category 'slot getters/setters') -----
  getNumberAtCursor
  	"Answer the number borne by the object at my costume's current cursor position"
  
  	| renderedMorph aCostume |
+ 	aCostume _ self costume.
+ 	((renderedMorph _ aCostume renderedMorph) respondsTo: #valueAtCursor:) ifTrue: [^ renderedMorph valueAtCursor renderedMorph getNumericValue]!
- 	aCostume := self costume.
- 	((renderedMorph := aCostume renderedMorph) respondsTo: #valueAtCursor:) ifTrue: [^ renderedMorph valueAtCursor getNumericValue]!

Item was added:
+ ----- Method: Player>>getNumberOfPages (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getNumberOfPages
+ 	"Answer how many pages the book currently has"
+ 
+ 	| aBook |
+ 	^ (aBook _ self bookEmbodied)
+ 		ifNotNil:
+ 			[aBook pages size]
+ 		ifNil:
+ 			[0]!

Item was added:
+ ----- Method: Player>>getObjectSize (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getObjectSize
+ 	"Answer the receiver's object size.  This is probably not the right thing to compute"
+ 
+ 	^ self class allInstVarNames size!

Item was added:
+ ----- Method: Player>>getOpaque (in category '*Etoys-Squeakland-MorphicExtras-AdditionalMorphs') -----
+ getOpaque
+ 	^self getValueFromCostume: #isOpaque!

Item was added:
+ ----- Method: Player>>getPageControlsAtTop (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getPageControlsAtTop
+ 	"Answer whether the book is currently set to show  page controls at top."
+ 
+ 	| aBook |
+ 	^ (aBook _ self bookEmbodied)
+ 		ifNotNil:
+ 			[aBook pageControlsAtTop]
+ 		ifNil:
+ 			[false]!

Item was added:
+ ----- Method: Player>>getPageControlsShort (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getPageControlsShort
+ 	"Answer whether the book is currentset to show short page controls"
+ 
+ 	| aBook |
+ 	^ (aBook _ self bookEmbodied)
+ 		ifNotNil:
+ 			[aBook pageControlsShort]
+ 		ifNil:
+ 			[false]!

Item was added:
+ ----- Method: Player>>getPageControlsShowing (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getPageControlsShowing
+ 	"Answer whether the book is current showing page-controls"
+ 
+ 	| aBook |
+ 	^ (aBook _ self bookEmbodied)
+ 		ifNotNil:
+ 			[aBook pageControlsVisible]
+ 		ifNil:
+ 			[false]!

Item was added:
+ ----- Method: Player>>getPageCount (in category '*Etoys-Squeakland-playing commands') -----
+ getPageCount
+ 
+ 	| b |
+ 	b _ Utilities scrapsBook renderedMorph.
+ 	^ b ifNotNil: [b pages size] ifNil: [1].
+ !

Item was added:
+ ----- Method: Player>>getPasteUpCursor (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getPasteUpCursor
+ 	"Obtain the cursor setting from a PasteUpMorph.  Given a separate getter so that it can have a separate entry in the vocabulary's dictionary of methodInterfaces."
+ 
+ 	^ self getCursor!

Item was added:
+ ----- Method: Player>>getPasteUpGraphic (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getPasteUpGraphic
+ 	"Obtain the graphic  from a PasteUpMorph.  Given a separate getter so that it can have a separate entry in the vocabulary's dictionary of methodInterfaces."
+ 
+ 	^ self getGraphic!

Item was added:
+ ----- Method: Player>>getPenTrailGraphic (in category '*Etoys-Squeakland-pen') -----
+ getPenTrailGraphic
+ 	"Answer a Form containing a snapshot of my pen trails."
+ 
+ 	^ (costume renderedMorph turtleTrailsForm ifNil:
+ 		[ScriptingSystem formAtKey: #NoTrails]) trimBordersOfColor: Color transparent
+ 
+ 	!

Item was added:
+ ----- Method: Player>>getPixelsPerUnit (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ getPixelsPerUnit
+ 		"Answer the number of pixels per unit on a number line"
+ 
+ 	^ costume renderedMorph pixelsPerUnit!

Item was added:
+ ----- Method: Player>>getPrecisionFor: (in category '*Etoys-Squeakland-slots-user') -----
+ getPrecisionFor: slotName 
+ 	"get the precision for the given slot name"
+ 
+ 	| aGetter places precision |
+ 	precision _ 1.
+ 	(self slotInfo includesKey: slotName) 
+ 				ifTrue: 
+ 					["it's a user slot"
+ 					precision _ (self slotInfoAt: slotName) floatPrecision]
+ 				ifFalse: 
+ 					["reference to system slots"
+ 					aGetter := Utilities getterSelectorFor: slotName.
+ 					self costume renderedMorph ifNotNilDo: [ :morph |
+ 						places _ morph decimalPlacesForGetter: aGetter.
+ 						precision _ Utilities floatPrecisionForDecimalPlaces: places ]].
+ 	^precision!

Item was added:
+ ----- Method: Player>>getPrintString (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getPrintString
+ 	"Answer a string representing the object"
+ 
+ 	^ self costume printString!

Item was changed:
  ----- Method: Player>>getRadialGradientFill (in category 'slot getters/setters') -----
  getRadialGradientFill
+ 	"Getter for costume's useGradientFill"
- 	"Geter for costume's useGradientFill"
  
  	| aStyle |
+ 	^ (self isFillStyle: (aStyle := costume renderedMorph fillStyle)) and:
+ 		[aStyle isGradientFill] and: [aStyle isRadialFill]!
- 	^ (aStyle := costume renderedMorph fillStyle) isGradientFill and:
- 		[aStyle isRadialFill]!

Item was added:
+ ----- Method: Player>>getRed (in category '*Etoys-Squeakland-slots-color components') -----
+ getRed
+ 	^ self getColor red * 100!

Item was added:
+ ----- Method: Player>>getRelativeScale (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getRelativeScale
+ 	^  costume relativeScale
+ !

Item was added:
+ ----- Method: Player>>getRotationCenter (in category '*Etoys-Squeakland-slots-bonus for geometry') -----
+ getRotationCenter
+ 	| morph point world aPlayfield |
+ 	morph := self costume renderedMorph.
+ 	point := morph bounds origin + (morph rotationCenter * morph extent).
+ 	(self costume isKindOf: TransformMorph)
+ 				ifTrue: [point := self costume transform localPointToGlobal: point].
+ 	world := self costume world.
+ 	world
+ 		ifNil: [^ point].
+ 	aPlayfield := morph referencePlayfield.
+ 	^ aPlayfield isNil
+ 		ifTrue: [point x - world cartesianOrigin x @ (world cartesianOrigin y - point y)]
+ 		ifFalse: [point x - aPlayfield cartesianOrigin x @ (aPlayfield cartesianOrigin y - point y)]!

Item was added:
+ ----- Method: Player>>getRotationCenterX (in category '*Etoys-Squeakland-slots-bonus for geometry') -----
+ getRotationCenterX
+ 	^ self getRotationCenter x!

Item was added:
+ ----- Method: Player>>getRotationCenterY (in category '*Etoys-Squeakland-slots-bonus for geometry') -----
+ getRotationCenterY
+ 	^ self getRotationCenter y!

Item was added:
+ ----- Method: Player>>getSamplingRate (in category '*Etoys-Squeakland-MorphicExtras-Widgets') -----
+ getSamplingRate
+ 	^ self getValueFromCostume: #getSamplingRate!

Item was added:
+ ----- Method: Player>>getSaturation (in category '*Etoys-Squeakland-slots-color components') -----
+ getSaturation
+ 	^ self getColor saturation * 100!

Item was added:
+ ----- Method: Player>>getSaturationShift (in category '*Etoys-Squeakland-sketch filters') -----
+ getSaturationShift
+ 	^ self getFilterValue: #saturationShift:form:!

Item was changed:
  ----- Method: Player>>getSecondColor (in category 'slot getters/setters') -----
  getSecondColor
  	"Getter for costume's second color, if it's using gradient fill; sonst answers white."
  
+ 	| fil |
+ 	^ ((self isFillStyle: (fil :=  costume renderedMorph fillStyle)) and: [fil isGradientFill])
- 	| aFillStyle |
- 	^ (aFillStyle := costume renderedMorph fillStyle) isGradientFill
  		ifTrue:
+ 			[fil  colorRamp last value]
- 			[aFillStyle  colorRamp last value]
  		ifFalse:
  			[Color white]!

Item was added:
+ ----- Method: Player>>getSectorAngle (in category '*Etoys-Squeakland-MorphicExtras-AdditionalMorphs') -----
+ getSectorAngle
+ 	^ self sendMessageToCostume: #angle!

Item was added:
+ ----- Method: Player>>getSectorRadius (in category '*Etoys-Squeakland-MorphicExtras-AdditionalMorphs') -----
+ getSectorRadius
+ 	^ self sendMessageToCostume: #radius!

Item was added:
+ ----- Method: Player>>getShowNegativeArrowHead (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ getShowNegativeArrowHead
+ 	^ self getValueFromCostume: #showNegativeArrowHead!

Item was added:
+ ----- Method: Player>>getShowPointer (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getShowPointer
+ 	"Answer the setting of my costume's showPointer"
+ 
+ 	^ self costume renderedMorph showPointer!

Item was added:
+ ----- Method: Player>>getShowZero (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ getShowZero
+ 	^ self getValueFromCostume: #showZero!

Item was added:
+ ----- Method: Player>>getShowingHandles (in category '*Etoys-Squeakland-vertices operation') -----
+ getShowingHandles
+ 
+ 	^ self costume showingHandles!

Item was added:
+ ----- Method: Player>>getStarRatio (in category '*Etoys-Squeakland-vertices operation') -----
+ getStarRatio
+ 	^ (self costume starRatio * 100) rounded!

Item was added:
+ ----- Method: Player>>getTextColor (in category '*Etoys-Squeakland-scripts-standard') -----
+ getTextColor
+ 
+ 	^ self costume renderedMorph selectionColor!

Item was added:
+ ----- Method: Player>>getTextCursor (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getTextCursor
+ 	"Obtain the cursor setting from a TextMorph.  Given a separate getter so that it can have a separate entry in the vocabulary's dictionary of methodInterfaces."
+ 
+ 	^ self getCursor!

Item was added:
+ ----- Method: Player>>getTimePressed (in category '*Etoys-Squeakland-etoys-input') -----
+ getTimePressed
+ 	^ self sendMessageToCostume: #timePressed!

Item was added:
+ ----- Method: Player>>getTimer (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getTimer
+ 	| last msecs |
+ 	last := costume renderedMorph
+ 		valueOfProperty:  #timerStart
+ 		ifAbsent: [0].
+ 	msecs := Time millisecondsSince: last.
+ 	"allow negative timer values, e.g. for count downs"
+ 	msecs > (SmallInteger maxVal // 2)
+ 		ifTrue: [msecs := msecs - SmallInteger maxVal]. 
+ 	^msecs / 1000.0!

Item was added:
+ ----- Method: Player>>getTrackPointer (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getTrackPointer
+ 	"Answer the setting of my costume's trackPointer"
+ 
+ 	^ self costume renderedMorph trackPointer!

Item was added:
+ ----- Method: Player>>getUnitsPerMark (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ getUnitsPerMark
+ 	^ 	self getValueFromCostume: #unitsPerMark!

Item was added:
+ ----- Method: Player>>getUseFrameSize (in category '*Etoys-Squeakland-MorphicExtras-WebCam') -----
+ getUseFrameSize
+ 	^ self getValueFromCostume: #getUseFrameSize.
+ 	!

Item was changed:
  ----- Method: Player>>getUseGradientFill (in category 'slot getters/setters') -----
  getUseGradientFill
+ 	"Getter for costume's useGradientFill"
- 	"Geter for costume's useGradientFill"
  
+ 	| fil |
+ 	^ (self isFillStyle: (fil := costume renderedMorph fillStyle))
+ 		ifFalse:
+ 			[false]
+ 		ifTrue:
+ 			[fil isGradientFill]!
- 	^ costume renderedMorph fillStyle isGradientFill!

Item was added:
+ ----- Method: Player>>getVertexCursor (in category '*Etoys-Squeakland-vertices operation') -----
+ getVertexCursor
+ 
+ 	^ self costume vertexCursor!

Item was added:
+ ----- Method: Player>>getVerticesCount (in category '*Etoys-Squeakland-vertices operation') -----
+ getVerticesCount
+ 
+ 	^ self costume vertices size!

Item was added:
+ ----- Method: Player>>getVideoGraphic (in category '*Etoys-Squeakland-slot getters/setters') -----
+ getVideoGraphic
+ 	"Obtain the graphic  from a VideoMorph.  Given a separate getter so that it can have a separate entry in the vocabulary's dictionary of methodInterfaces."
+ 
+ 	^ self getGraphic!

Item was added:
+ ----- Method: Player>>getWebCamIsOn (in category '*Etoys-Squeakland-MorphicExtras-WebCam') -----
+ getWebCamIsOn
+ 	^ self getValueFromCostume: #getWebCamIsOn!

Item was added:
+ ----- Method: Player>>getWebCamResolution (in category '*Etoys-Squeakland-MorphicExtras-WebCam') -----
+ getWebCamResolution
+ 	^ self getValueFromCostume: #getWebCamResolution!

Item was added:
+ ----- Method: Player>>getWhirl (in category '*Etoys-Squeakland-sketch filters') -----
+ getWhirl
+ 	^ self getFilterValue: #whirl:form:!

Item was added:
+ ----- Method: Player>>getXAtCursor (in category '*Etoys-Squeakland-vertices operation') -----
+ getXAtCursor
+ 
+ 	^ (self costume xAtCursor) !

Item was added:
+ ----- Method: Player>>getXOnGraph (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ getXOnGraph
+ 	"Answer the x-coordinate with respect to a corresponding horizontal axis, if any; if none, answer the cartesian x"
+ 
+ 	| aCostume |
+ 	(aCostume _ self costume) isInWorld ifFalse: [^ self getX].
+ 
+ 	(aCostume referencePlayfield findA: HorizontalNumberLineMorph) ifNotNilDo:
+ 		[:aNumberLine |
+ 			^ aNumberLine horizontalCoordinateOf: aCostume].
+ 	^ self getX!

Item was added:
+ ----- Method: Player>>getYAtCursor (in category '*Etoys-Squeakland-vertices operation') -----
+ getYAtCursor
+ 
+ 	^ (self costume yAtCursor) !

Item was added:
+ ----- Method: Player>>getYOnGraph (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ getYOnGraph
+ 	"Answer the y-coordinate with respect to a corresponding horizontal axis, if any; if none, answer the cartesian x"
+ 
+ 	| aCostume |
+ 	(aCostume := self costume) isInWorld ifFalse: [^ self getY].
+ 
+ 	(aCostume referencePlayfield findA: VerticalNumberLineMorph) ifNotNilDo:
+ 		[:aNumberLine |
+ 			^ aNumberLine verticalCoordinateOf: aCostume].
+ 	^ self getY!

Item was added:
+ ----- Method: Player>>getYear (in category '*Etoys-Squeakland-etoys-calendar') -----
+ getYear
+ 	"Answer the selected year, as a number, e.g. 2011."
+ 
+ 	^ self costume renderedMorph date year!

Item was added:
+ ----- Method: Player>>goToToday (in category '*Etoys-Squeakland-etoys-calendar') -----
+ goToToday
+ 	"Tell the calendar to use the current day as its selected dated."
+ 
+ 	self costume renderedMorph date: Date today!

Item was changed:
  ----- Method: Player>>grabScriptorForSelector:in: (in category 'misc') -----
  grabScriptorForSelector: itsSelector in: aWorld
  	"Grab the scriptor for the given selector and place it in the hand"
  
+ 	| editor |
+ 	editor := self scriptEditorFor: itsSelector.
+ 	editor fixLayout.
+ 	aWorld currentHand attachMorph: (editor).
+ 	
+ 	
+ 	
+ 	
+ 	
+ 
+ 	
+ 	!
- 	aWorld currentHand attachMorph: (self scriptEditorFor: itsSelector) !

Item was added:
+ ----- Method: Player>>handUserPictureOfPenTrail (in category '*Etoys-Squeakland-slot getters/setters') -----
+ handUserPictureOfPenTrail
+ 	"Called from the user-interface: hand the user a picture of the pen trail"
+ 
+ 	self getHasPenTrails
+ 		ifFalse:
+ 			[^ self inform: 'no pen trails present' translated]
+ 		ifTrue:
+ 			[ActiveHand attachMorph: (SketchMorph new form: self getPenTrailGraphic)]!

Item was changed:
  ----- Method: Player>>headDown (in category 'heading') -----
  headDown
  
  	| radians |
+ 	radians _ (self getHeadingUnrounded - 90.0) degreesToRadians.
- 	radians := (self getHeadingUnrounded - 90.0) degreesToRadians.
  	self setHeading:
+ 		(radians cos @ radians sin abs) theta radiansToDegrees + 90.0.
- 		((radians cos @ radians sin abs) theta radiansToDegrees
- 			roundTo: 0.001) + 90.0.
  !

Item was changed:
  ----- Method: Player>>headLeft (in category 'heading') -----
  headLeft
  
  	| radians |
+ 	radians _ (self getHeadingUnrounded - 90.0) degreesToRadians.
+ 	self setHeading: (radians cos abs negated @ radians sin) theta radiansToDegrees + 90.0.
- 	radians := (self getHeadingUnrounded - 90.0) degreesToRadians.
- 	self setHeading:
- 		((radians cos abs negated @ radians sin) theta radiansToDegrees
- 			roundTo: 0.001) + 90.0.
  !

Item was changed:
  ----- Method: Player>>headRight (in category 'heading') -----
  headRight
  
  	| radians |
+ 	radians _ (self getHeadingUnrounded - 90.0) degreesToRadians.
+ 	self setHeading: (radians cos abs @ radians sin) theta radiansToDegrees + 90.0.
- 	radians := (self getHeadingUnrounded - 90.0) degreesToRadians.
- 	self setHeading:
- 		((radians cos abs @ radians sin) theta radiansToDegrees
- 			roundTo: 0.001) + 90.0.
  !

Item was changed:
  ----- Method: Player>>headUp (in category 'heading') -----
  headUp
  
  	| radians |
+ 	radians _ (self getHeadingUnrounded - 90.0) degreesToRadians.
+ 	self setHeading: (radians cos @ radians sin abs negated) theta radiansToDegrees + 90.0.
- 	radians := (self getHeadingUnrounded - 90.0) degreesToRadians.
- 	self setHeading:
- 		((radians cos @ radians sin abs negated) theta radiansToDegrees
- 			roundTo: 0.001) + 90.0.
  !

Item was changed:
  ----- Method: Player>>hide (in category 'scripts-standard') -----
  hide
  	"Make the object be hidden, as opposed to visible"
  
+ 	ActiveHand ifNotNil:
+ 		[(ActiveHand keyboardFocus == self costume renderedMorph) ifTrue: [ActiveHand releaseKeyboardFocus]].
  	self costume hide!

Item was added:
+ ----- Method: Player>>hideNavigationBar (in category '*Etoys-Squeakland-misc') -----
+ hideNavigationBar
+ 	"Hide the navigation bar at the top of the screen"
+ 
+ 	| tab |
+ 	((tab := costume world findA: SugarNavTab) notNil)
+ 		ifTrue:
+ 			[tab collapsedMode
+ 				ifFalse:
+ 					[tab hideNavBar]]!

Item was changed:
  ----- Method: Player>>includeAtCursor: (in category 'scripts-standard') -----
  includeAtCursor: aPlayer 
  	"Add aPlayer to the list of objects logically 'within' me, at my current cursor position. ."
  
  	| aCostume |
  	(aPlayer isNil or: [aPlayer == self]) ifTrue: [^self].
  	(aPlayer isText or: [aPlayer isString]) 
  		ifTrue: 
  			[^ self costume class == TextFieldMorph 
  				ifTrue: [self costume append: aPlayer]
  				ifFalse: [self]].
  	aCostume := self costume topRendererOrSelf.
- 	aPlayer costume goHome.	"assure it's in view"
  	(aCostume isKindOf: PasteUpMorph) 
  		ifTrue:
  			[aCostume addMorph: aPlayer costume asElementNumber: self getCursor.
+ 			aCostume updateSubmorphThumbnails]  "also forces redraw"
- 			aCostume invalidRect: aCostume bounds]
  		ifFalse:
  			[aCostume addMorphBack: aPlayer.
+ 			self setCursor: aCostume submorphs size].
+ 	aPlayer costume goHome.	"assure it's in view"
+ !
- 			self setCursor: aCostume submorphs size]!

Item was changed:
  ----- Method: Player>>infoFor:inViewer: (in category 'viewer') -----
  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!

Item was added:
+ ----- Method: Player>>insertVertexAtCursor (in category '*Etoys-Squeakland-vertices operation') -----
+ insertVertexAtCursor
+ 
+ 	self costume insertVertexAtCursor!

Item was changed:
  ----- Method: Player>>isExpendableScript: (in category 'scripts-kernel') -----
  isExpendableScript: aScriptName
  	^ (self isEmptyTileScript: aScriptName) and:
+ 		[aScriptName beginsWith: self defaultScriptName]
- 		[aScriptName beginsWith: 'script' translated]
  !

Item was added:
+ ----- Method: Player>>isFillStyle: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ isFillStyle: prospective
+ 	"Answer whether the argument is some kind of fill-style."
+ 
+ 	^ prospective notNil and: [prospective isSymbol not]
+ !

Item was added:
+ ----- Method: Player>>isInTrash (in category '*Etoys-Squeakland-misc') -----
+ isInTrash
+ 	"Return true if I am in the trash (ScrapsBook)"
+ 
+ 	| next |
+ 	costume ifNil: [^ false].
+ 	next := costume.
+ 	[(next := next owner) notNil] whileTrue: 
+ 		[(next hasProperty: #trash) ifTrue: [^ true].
+ 		 (next hasProperty: #scraps) ifTrue: [^ true]].
+ 	^ false
+ !

Item was added:
+ ----- Method: Player>>isOpaque: (in category '*Etoys-Squeakland-MorphicExtras-AdditionalMorphs') -----
+ isOpaque: aBoolean
+ 	self costume isOpaque: aBoolean!

Item was added:
+ ----- Method: Player>>isStepping (in category '*Etoys-Squeakland-MorphicExtras-AdditionalMorphs') -----
+ isStepping
+ 	^self costume isStepping!

Item was added:
+ ----- Method: Player>>kedamaWorld (in category '*Etoys-Squeakland-slot-kedama') -----
+ kedamaWorld
+   ^ActiveWorld findDeeplyA: KedamaMorph
+ 	!

Item was changed:
  ----- Method: Player>>moveToward: (in category 'scripts-standard') -----
  moveToward: aPlayer
  	"Move a standard amount in the direction of the given player.  If the object has an instance variable named 'speed', the speed of the motion will be governed by that value"
  
+ 	| myPosition itsPosition dist delta |
- 	| myPosition itsPosition |
  	((aPlayer ~~ self) and: [(self overlaps: aPlayer) not]) ifTrue:
+ 		[((myPosition _ self costume referencePosition) = (itsPosition _ aPlayer costume referencePosition))
- 		[((myPosition := self costume referencePosition) = (itsPosition := aPlayer costume referencePosition))
  			ifFalse:
  				[self setHeading: (myPosition bearingToPoint: itsPosition).
+ 				delta _ myPosition - itsPosition.
+ 				dist _ (delta x * delta x + (delta y * delta y)) sqrt.
+ 				self forward: (self getSpeed min: dist)]]!
- 				self forward: self getSpeed]]!

Item was changed:
  ----- Method: Player>>newCostume (in category 'costume') -----
  newCostume
  
+ 	| aMenu reply |
+ 	aMenu _ SelectionMenu selections: self availableCostumeNames.
+ 	(reply _ aMenu startUpWithCaption: 'choose a costume' translated) ifNil: [^ self].
- 	| reply |
- 	(reply := UIManager default 
- 		chooseFrom: self availableCostumeNames 
- 		values: self availableCostumeNames 
- 		title: 'choose a costume') ifNil: [^ self].
  	self wearCostumeOfName: reply.
  	self updateAllViewers!

Item was changed:
  ----- Method: Player>>newPatch (in category 'slot-kedama') -----
  newPatch
  
+ 	| f usedNames newName |
+ 	f _ KedamaPatchMorph newExtent: self costume renderedMorph dimensions.
- 	| f |
- 	f := KedamaPatchMorph newExtent: self costume renderedMorph dimensions.
  	f assuredPlayer assureUniClass.
+ 	f kedamaWorld: self costume renderedMorph.
+ 	usedNames _ ActiveWorld allKnownNames, self class instVarNames.
+ 	newName _ Utilities keyLike: f innocuousName satisfying:
+ 		[:aName | (usedNames includes: aName) not].
+ 	f setNameTo: newName.
- 	f setNameTo: (ActiveWorld unusedMorphNameLike: f innocuousName).
  	self createSlotForPatch: f.
  	self addToPatchDisplayList: f assuredPlayer.
  	self costume world primaryHand attachMorph: f.
  	^ f.
  !

Item was added:
+ ----- Method: Player>>newPatchForSet (in category '*Etoys-Squeakland-slot-kedama') -----
+ newPatchForSet
+ 
+ 	| f |
+ 	f _ KedamaPatchMorph newExtent: self costume renderedMorph dimensions.
+ 	f assuredPlayer assureUniClass.
+ 	f setNameTo: (ActiveWorld unusedMorphNameLike: f innocuousName).
+ 	f kedamaWorld: self costume renderedMorph.
+ 	self createSlotForPatch: f.
+ 	^ f.
+ !

Item was changed:
  ----- Method: Player>>newScriptorAround: (in category 'viewer') -----
  newScriptorAround: aPhrase
  	"Sprout a scriptor around aPhrase, thus making a new script.  aPhrase may either be a PhraseTileMorph (classic tiles 1997-2001) or a SyntaxMorph (2001 onward)"
  
  	| aScriptEditor aUniclassScript tw blk |
+ Cursor wait showWhile: [
+ 	aUniclassScript _ self class permanentUserScriptFor: self unusedScriptName player: self.
+ 	aScriptEditor _ aUniclassScript instantiatedScriptEditorForPlayer: self.
- 	aUniclassScript := self class permanentUserScriptFor: self unusedScriptName player: self.
- 	aScriptEditor := aUniclassScript instantiatedScriptEditorForPlayer: self.
  
  	Preferences universalTiles ifTrue: [
  		aScriptEditor install.
  		"aScriptEditor hResizing: #shrinkWrap;
  			vResizing: #shrinkWrap;
  			cellPositioning: #topLeft;
  			setProperty: #autoFitContents toValue: true."
  		aScriptEditor insertUniversalTiles.  "Gets an empty SyntaxMorph for a MethodNode"
+ 		tw _ aScriptEditor findA: TwoWayScrollPane.
- 		tw := aScriptEditor findA: TwoWayScrollPane.
  		aPhrase ifNotNil:
+ 			[blk _ (tw scroller findA: SyntaxMorph "MethodNode") findA: BlockNode.
- 			[blk := (tw scroller findA: SyntaxMorph "MethodNode") findA: BlockNode.
  			blk addMorphFront: aPhrase.
  			aPhrase accept.
  		].
  		SyntaxMorph setSize: nil andMakeResizable: aScriptEditor.
  	] ifFalse: [
  		aPhrase 
  				ifNotNil: [aScriptEditor phrase: aPhrase]	"does an install"
  				ifNil: [aScriptEditor install]
  	].
  	self class allSubInstancesDo: [:anInst | anInst scriptInstantiationForSelector: aUniclassScript selector].
  		"The above assures the presence of a ScriptInstantiation for the new selector in all siblings"
+ 	self updateScriptsCategoryOfViewers.
+ ].
- 	self updateAllViewersAndForceToShow: #scripts.
  	^ aScriptEditor!

Item was changed:
  ----- Method: Player>>newTurtle (in category 'slot-kedama') -----
  newTurtle
  
  	| m |
+ 	m _ KedamaTurtleMorph new openInWorld.
+ 	self costume renderedMorph hasNoTurtleBreed ifTrue: [m color: Color red].
- 	m := KedamaTurtleMorph new openInWorld.
- 	self costume hasNoTurtleBreed ifTrue: [m color: Color red].
  	self useTurtle: m player.
  	m setNameTo: (ActiveWorld unusedMorphNameLike: m innocuousName).
  	self costume world primaryHand attachMorph: m.
  	^ m.
  !

Item was added:
+ ----- Method: Player>>newTurtleForSet (in category '*Etoys-Squeakland-slot-kedama') -----
+ newTurtleForSet
+ 
+ 	| m |
+ 	m _ KedamaTurtleMorph new openInWorld.
+ 	self costume renderedMorph hasNoTurtleBreed ifTrue: [m color: Color red].
+ 	self useTurtle: m player.
+ 	m setNameTo: (ActiveWorld unusedMorphNameLike: m innocuousName).
+ 	^ m.
+ !

Item was changed:
  ----- Method: Player>>noteDecimalPlaces:forGetter: (in category 'misc') -----
  noteDecimalPlaces: aNumber forGetter: aGetter
  	"Note the given preference of decimal places for the given getter"
+ 	| slotInfo |
+ 	slotInfo := self slotInfoForGetter: aGetter.
+ 	slotInfo ifNotNil:[ slotInfo floatPrecision: (Utilities floatPrecisionForDecimalPlaces: aNumber)].
- 
  	costume noteDecimalPlaces: aNumber forGetter: aGetter!

Item was changed:
  ----- Method: Player>>offerAlternateViewerMenuFor:event: (in category 'misc') -----
  offerAlternateViewerMenuFor: aViewer event: evt
  	"Put up an alternate Viewer menu on behalf of the receiver."
  
  	| aMenu aWorld  |
+ 	aWorld _ aViewer world.
+ 	aMenu _ MenuMorph new defaultTarget: self.
- 	aWorld := aViewer world.
- 	aMenu := MenuMorph new defaultTarget: self.
  	costumes ifNotNil:
+ 		[(costumes size > 1 or: [costumes size == 1 and: [costumes first ~~ costume renderedMorph]])
- 		[(costumes size > 1 or: [costumes size = 1 and: [costumes first ~~ costume renderedMorph]])
  			ifTrue:
  				[aMenu add: 'forget other costumes' translated target: self selector: #forgetOtherCostumes]].
  
  	aMenu add: 'expunge empty scripts' translated target: self action: #expungeEmptyScripts.
  	aMenu addLine.
  	aMenu add: 'choose vocabulary...' translated target: aViewer action: #chooseVocabulary.
  	aMenu balloonTextForLastItem: 'Choose a different vocabulary for this Viewer.' translated.
  	aMenu add: 'choose limit class...' translated target: aViewer action: #chooseLimitClass.
  	aMenu balloonTextForLastItem: 'Specify what the limitClass should be for this Viewer -- i.e., the most generic class whose methods and categories should be considered here.' translated.
  
  	aMenu add: 'open standard lexicon' translated target: aViewer action: #openLexicon.
  	aMenu balloonTextForLastItem: 'open a window that shows the code for this object in traditional programmer format' translated.
  
  	aMenu add: 'open lexicon with search pane' translated target: aViewer action: #openSearchingProtocolBrowser.
  	aMenu balloonTextForLastItem: 'open a lexicon that has a type-in pane for search (not recommended!!)' translated.
  
  
  	aMenu addLine.
  	aMenu add: 'inspect morph' translated target: costume selector: #inspect.
  	aMenu add: 'inspect player' translated target: self selector: #inspect.
  	self belongsToUniClass ifTrue:
  		[aMenu add: 'browse class' translated target: self action: #browsePlayerClass.
  		aMenu add: 'inspect class' translated target: self class action: #inspect].
  	aMenu add: 'inspect this Viewer' translated target: aViewer selector: #inspect.
  	aMenu add: 'inspect this Vocabulary' translated target: aViewer currentVocabulary selector: #inspect.
  
  	aMenu addLine.
  	aMenu add: 'relaunch this Viewer' translated target: aViewer action: #relaunchViewer.
  	aMenu add: 'attempt repairs' translated target: ActiveWorld action: #attemptCleanup.
+ 	aMenu add: 'destroy all this object''s scripts' translated target: self action: #destroyAllScripts.
  	aMenu add: 'view morph directly' translated target: aViewer action: #viewMorphDirectly.
  	aMenu balloonTextForLastItem: 'opens a Viewer directly on the rendered morph.' translated.
  	(costume renderedMorph isSketchMorph) ifTrue:
  		[aMenu addLine.
  		aMenu add: 'impart scripts to...' translated target: self action: #impartSketchScripts].
  
  	aMenu popUpEvent: evt in: aWorld!

Item was changed:
  ----- Method: Player>>offerViewerMenuFor:event: (in category 'misc') -----
  offerViewerMenuFor: aViewer event: evt
  	"Put up the Viewer menu on behalf of the receiver.  If the shift key is held down, put up the alternate menu. The menu omits the 'add a new variable' item when in eToyFriendly mode, as per request from teachers using Squeakland in 2003 once the button for adding a new variable was added to the viewer"
  
  	| aMenu aWorld  |
+ 	(evt notNil and: [evt shiftPressed and: [Preferences eToyFriendly not]]) ifTrue:
+ 		[^ self offerAlternateViewerMenuFor: aViewer event: evt].
- 	(evt notNil and: [evt shiftPressed and: [Preferences eToyFriendly not]]) ifTrue:[
- 		^ self offerAlternateViewerMenuFor: aViewer event: evt
- 	].
  
+ 	aWorld _ aViewer world.
+ 	aMenu _ MenuMorph new defaultTarget: self.
- 	aWorld := aViewer world.
- 	aMenu := MenuMorph new defaultTarget: self.
  	aMenu title: self externalName.
  	aMenu addStayUpItem.
+ 
  	self costume renderedMorph offerCostumeViewerMenu: aMenu.
  
  	Preferences eToyFriendly ifFalse: "exclude this from squeakland-like UI "
  		[aMenu add: 'add a new variable' translated target: self action: #addInstanceVariable.
  		aMenu balloonTextForLastItem: 'Add a new variable to this object and all of its siblings.  You will be asked to supply a name for it.' translated].
  
  	aMenu add: 'add a new script' translated target: aViewer action: #newPermanentScript.
  	aMenu balloonTextForLastItem: 'Add a new script that will work for this object and all of its siblings' translated.
  	aMenu addLine.
+ 	aMenu add: 'grab this object' translated target: self selector: #grabPlayerIn: argument: aWorld.
- 	self hasCostumeThatIsAWorld ifFalse:[
- 	
- 	aMenu add: 'grab me' translated target: self selector: #grabPlayerIn: argument: aWorld.
- 	
  	aMenu balloonTextForLastItem: 'This will actually pick up the object this Viewer is looking at, and hand it to you.  Click the (left) button to drop it' translated.
- 	].
  
+ 	aMenu add: 'reveal this object' translated target: self selector: #revealPlayerIn: argument: aWorld.
- 	aMenu add: 'reveal me' translated target: self selector: #revealPlayerIn: argument: aWorld.
  	aMenu balloonTextForLastItem: 'If you have misplaced the object that this Viewer is looking at, use this item to (try to) make it visible' translated.
  
+ 	aMenu add: 'tile representing this object' translated action: #tearOffTileForSelf.
+ 	aMenu balloonTextForLastItem: 'choose this to obtain a tile which represents the object associated with this script' translated.
  	aMenu addLine.
- 	aMenu add: 'tile representing me' translated action: #tearOffTileForSelf.
- 	aMenu add: 'add search pane' translated target: aViewer action: #addSearchPane.
- 	Preferences eToyFriendly ifFalse:[
- 	
- 	aMenu addLine.
- 	
- 	aMenu add: 'more...' translated target: self selector: #offerAlternateViewerMenuFor:event: argumentList: {aViewer. evt}.
- 	].
  
+ 	aMenu add: 'add a search pane' translated target: aViewer action: #addSearchPane.
+ 	Preferences eToyFriendly ifFalse: [
+ 		aMenu addLine.
+ 		aMenu add: 'more...' translated target: self selector: #offerAlternateViewerMenuFor:event: argumentList: {aViewer. evt}].
+ 
  	aMenu popUpEvent: evt in: aWorld
  !

Item was changed:
  ----- Method: Player>>okayToRemoveSlotNamed: (in category 'scripts-kernel') -----
  okayToRemoveSlotNamed: aSlotName
+ 	(self costume renderedMorph isMemberOf: KedamaMorph) ifTrue: [
+ 		aSlotName = 'patch' ifTrue: [^ false].
+ 	].
  	self costume world presenter allExtantPlayers do:
  		[:aPlayer | (aPlayer hasScriptReferencing: aSlotName ofPlayer: self)
  			ifTrue:
  				[^ false]].
  	^ true!

Item was changed:
  ----- Method: Player>>overlaps: (in category 'misc') -----
  overlaps: aPlayer 
  	"Answer whether my costume overlaps that of another player"
  
+ 	| goalCostume intersection |
- 	| goalCostume intersection myShadow goalShadow bb myRect goalRect |
  	aPlayer ifNil: [^false].
  	goalCostume := aPlayer costume.
  	costume world == goalCostume world ifFalse: [^false].
  
  	"check if the 2 player costumes intersect"
  	intersection := costume bounds intersect: goalCostume bounds.
  	(intersection width = 0 or: [intersection height = 0]) 
  		ifTrue: [^false]
  		ifFalse: 
+ 			[ ^self costume overlapsShadowForm: goalCostume imageForm stencil bounds: goalCostume fullBounds ]!
- 			["check if the overlapping region is non-transparent"
- 
- 			"compute 1-bit, black and white versions (stencils) of the intersecting  
- 			part of each morph's costume"
- 
- 			myRect := intersection translateBy: 0 @ 0 - costume topLeft.
- 			myShadow := (costume imageForm contentsOfArea: myRect) stencil.
- 			goalRect := intersection translateBy: 0 @ 0 - goalCostume topLeft.
- 			goalShadow := (goalCostume imageForm contentsOfArea: goalRect) stencil.
- 
- 			"compute a pixel-by-pixel AND of the two stencils.  Result will be black 
- 			(pixel value = 1) where black parts of the stencils overlap"
- 			bb := BitBlt toForm: myShadow.
- 			bb 
- 				copyForm: goalShadow
- 				to: 0 @ 0
- 				rule: Form and.
- 
- 			"return TRUE if resulting form contains any black pixels"
- 			^(bb destForm tallyPixelValues second) > 0]!

Item was changed:
  ----- Method: Player>>overlapsAny: (in category 'scripts-standard') -----
  overlapsAny: aPlayer 
  	"Answer true if my costume overlaps that of aPlayer, or any of its  
  	siblings (if aPlayer is a scripted player)  
  	or if my costume overlaps any morphs of the same class (if aPlayer is  
  	unscripted)."
+ 	| possibleCostumes itsCostume itsCostumeClass myShadow |
- 	| possibleCostumes itsCostumeClass myShadow |
  	(self ~= aPlayer
  			and: [self overlaps: aPlayer])
+ 		ifTrue: [^true].
- 		ifTrue: [^ true].
  	possibleCostumes := IdentitySet new.
  	aPlayer belongsToUniClass
  		ifTrue: [aPlayer class
+ 				allSubInstancesDo: [:anInstance | (anInstance ~~ self
- 				allSubInstancesDo: [:anInstance | | itsCostume |
- 					(anInstance ~~ aPlayer
  							and: [itsCostume := anInstance costume.
  								(itsCostume bounds intersects: costume bounds)
  									and: [itsCostume world == costume world]])
  						ifTrue: [possibleCostumes add: itsCostume]]]
  		ifFalse: [itsCostumeClass := aPlayer costume class.
  			self costume world presenter allExtantPlayers
+ 				do: [:ep | self ~= ep ifTrue:[ ep costume 
+ 						ifNotNilDo: [:ea | (ea class == itsCostumeClass
- 				do: [:ep | ep costume
- 						ifNotNil: [:ea | (ea class == itsCostumeClass
  									and: [ea bounds intersects: costume bounds])
+ 								ifTrue: [possibleCostumes add: ea]]]]].
- 								ifTrue: [possibleCostumes add: ea]]]].
  	possibleCostumes isEmpty
  		ifTrue: [^ false].
  	myShadow := costume shadowForm.
+ 	^possibleCostumes
+ 		anySatisfy: [:m | m overlapsShadowForm: myShadow bounds: costume fullBounds].
+ 	
+ !
- 	^ possibleCostumes
- 		anySatisfy: [:m | m overlapsShadowForm: myShadow bounds: costume fullBounds]!

Item was added:
+ ----- Method: Player>>playButtonHit (in category '*Etoys-Squeakland-scripts-standard') -----
+ playButtonHit
+ 	"The play button was hit."
+ 
+ 	 costume renderedMorph playButtonHit!

Item was added:
+ ----- Method: Player>>playFromCursorTo: (in category '*Etoys-Squeakland-MorphicExtras-Widgets') -----
+ playFromCursorTo: aSampleNumber
+ 	costume renderedMorph playFromCursorTo: aSampleNumber!

Item was added:
+ ----- Method: Player>>playSound: (in category '*Etoys-Squeakland-sound') -----
+ playSound: frequency 
+ 	| newSound soundName |
+ 	self stopSound.
+ 	(soundName := self costume valueOfProperty: #sound)
+ 		ifNotNil: [newSound := SoundService default soundNamed: soundName.
+ 			newSound pitch: frequency].
+ 	(soundName isNil
+ 			or: [soundName = 'silence'])
+ 		ifTrue: [newSound := FMSound new
+ 						soundForPitch: frequency
+ 						dur: 100.0
+ 						loudness: 0.3].
+ 	self costume setProperty: #playingSound toValue: newSound.
+ 	SoundPlayer resumePlaying: newSound quickStart: true!

Item was changed:
  ----- Method: Player>>prepend: (in category 'scripts-standard') -----
  prepend: aPlayer 
  	"Add aPlayer to the list of objects logically 'within' me.  This is visually represented by its morph becoming my costume's first submorph.   Also allow text to be prepended."
  
  	| aCostume |
  	(aPlayer isNil or: [aPlayer == self]) ifTrue: [^self].
  	(aPlayer isText or: [aPlayer isString]) 
  		ifTrue: 
  			[^ self costume class == TextFieldMorph 
  				ifTrue: [self costume prepend: aPlayer]
  				ifFalse: [self]].
  	(aCostume := self costume topRendererOrSelf) 
  		addMorphFront: aPlayer costume.
  	aPlayer costume goHome.	"assure it's in view"
  	(aCostume isKindOf: PasteUpMorph) 
+ 		ifTrue:
+ 			[self setCursor: (aCostume submorphs indexOf: aPlayer costume).
+ 			aCostume updateSubmorphThumbnails]!
- 		ifTrue: [self setCursor: (aCostume submorphs indexOf: aPlayer costume)]!

Item was added:
+ ----- Method: Player>>prependVertex (in category '*Etoys-Squeakland-vertices operation') -----
+ prependVertex
+ 
+ 	self costume prependVertex!

Item was added:
+ ----- Method: Player>>printInTranscript (in category '*Etoys-Squeakland-scripts-standard') -----
+ printInTranscript
+ 	"Print a line representing the receiver in the Transcript"
+ 
+ 	ActiveWorld findATranscript: nil.
+ 	Transcript cr;
+ 		show: (Time now printString copyWithoutAll: '()');
+ 		space;
+ 		show: self costume printString!

Item was added:
+ ----- Method: Player>>random: (in category '*Etoys-Squeakland-slot-kedama') -----
+ random: range
+ 	"Answer a random integer between 0 and range."
+ 
+ 	| r val |
+ 	<primitive: 'randomRange' module: 'KedamaPlugin2'>
+ 	r _ range < 0 ifTrue: [range negated] ifFalse: [range].
+ 	RandomSeed _ ((RandomSeed * 1309) + 13849) bitAnd: 65535.
+ 	val _ (RandomSeed * (r + 1)) >> 16.
+ 	^ range < 0 ifTrue: [val negated] ifFalse: [^ val].
+ 
+ !

Item was added:
+ ----- Method: Player>>recordButtonHit (in category '*Etoys-Squeakland-scripts-standard') -----
+ recordButtonHit
+ 	"The record button was hit."
+ 
+ 	 costume renderedMorph recordButtonHit!

Item was added:
+ ----- Method: Player>>referencePool (in category '*Etoys-Squeakland-as yet unclassified') -----
+ referencePool
+ 
+ 	self costume ifNotNilDo: [:c | c referenceWorld ifNotNilDo: [:w | ^ w referencePool]].
+ 	^ nil.
+ !

Item was added:
+ ----- Method: Player>>regenerateScripts (in category '*Etoys-Squeakland-as yet unclassified') -----
+ regenerateScripts
+ 	"This method is a temporary measure to ensure the project local References get in the compiled scripts.  (When compiled methods are recompiled via #compileAll, it is done in a ways that it ignores the environment."
+ 
+ 	self class scripts do: [:e | (e instantiatedScriptEditorForPlayer: self) install].
+ !

Item was added:
+ ----- Method: Player>>removeAllButCursor (in category '*Etoys-Squeakland-vertices operation') -----
+ removeAllButCursor
+ 
+ 	self costume removeAllButCursor!

Item was added:
+ ----- Method: Player>>removeFilters (in category '*Etoys-Squeakland-sketch filters') -----
+ removeFilters
+ 	self sendMessageToCostume: #removeFilters!

Item was added:
+ ----- Method: Player>>removeScriptNamed: (in category '*Etoys-Squeakland-slots-kernel') -----
+ removeScriptNamed: aScriptName
+ 	self class removeScriptNamed: aScriptName.
+ !

Item was changed:
  ----- Method: Player>>removeScriptWithoutUpdatingViewers: (in category 'scripts-kernel') -----
  removeScriptWithoutUpdatingViewers: aSymbol
  	self pacifyScript: aSymbol.
+ 	self removeScriptNamed: aSymbol.
- 	self class removeScriptNamed: aSymbol.
  
  	(self scriptorsForSelector: aSymbol inWorld: costume world) do:
  		[:s | s privateDelete].
  !

Item was changed:
  ----- Method: Player>>removeScriptWithoutUpdatingViewers:fromWorld: (in category 'scripts-kernel') -----
  removeScriptWithoutUpdatingViewers: aSymbol fromWorld: aWorld
  	self pacifyScript: aSymbol.
+ 	self removeScriptNamed: aSymbol.
- 	self class removeScriptNamed: aSymbol.
  
  	(self scriptorsForSelector: aSymbol inWorld: aWorld) do:
  		[:s | s privateDelete].
  !

Item was added:
+ ----- Method: Player>>removeVertexAtCursor (in category '*Etoys-Squeakland-vertices operation') -----
+ removeVertexAtCursor
+ 
+ 	self costume removeVertexAtCursor!

Item was added:
+ ----- Method: Player>>removeWatchersOfSlotNamed: (in category '*Etoys-Squeakland-translation') -----
+ removeWatchersOfSlotNamed: aName
+ 	"A variable has been removed.  Deal with possible watchers."
+ 
+ 	| aGetter |
+ 	aGetter _ Utilities getterSelectorFor: aName.
+ 	self allPossibleWatchersFromWorld do: [:aWatcher |
+ 		(aWatcher getSelector = aGetter) ifTrue:
+ 			[aWatcher stopStepping.
+ 			(aWatcher ownerThatIsA: WatcherWrapper) ifNotNilDo:
+ 				[:aWrapper | aWrapper delete]]]!

Item was changed:
  ----- Method: Player>>renameScript: (in category 'scripts-kernel') -----
  renameScript: oldSelector 
  	"The user has asked to rename the script formerly known by oldSelector; obtain a new selector from the user, check it out, and if all is well, ascribe the new name as appropriate"
  
  	| reply newSelector aUserScript |
  	self flag: #deferred.
  	"Relax the restriction below, before too long"
  	aUserScript := self class userScriptForPlayer: self selector: oldSelector.
  	aUserScript okayToRename 
  		ifFalse: 
  			[self 
  				inform: 'Sorry, we do not permit you to rename
  classic-tiled scripts that are currently
  textually coded.  Go back to tile scripts
  and try again.  Humble apologies.' translated.
  			^self].
+ 	reply := FillInTheBlank request: 'Script Name' translated initialAnswer: oldSelector.
- 	reply := UIManager default request: 'Script Name' translated initialAnswer: oldSelector.
  	reply isEmpty ifTrue: [^self].
  	reply = oldSelector ifTrue: [^Beeper beep].
  	newSelector := self acceptableScriptNameFrom: reply
  				forScriptCurrentlyNamed: oldSelector.
  	Preferences universalTiles 
  		ifTrue: 
  			["allow colons"
  
  			(reply copyWithout: $:) = newSelector 
  				ifTrue: [newSelector := reply asSymbol]
  				ifFalse: [self inform: 'name will be modified']].
  	self renameScript: oldSelector newSelector: newSelector!

Item was changed:
  ----- Method: Player>>renameScript:newSelector: (in category 'scripts-kernel') -----
  renameScript: oldSelector newSelector: newSelector
  	"Rename the given script to have the new selector"
  
+ 	|  aUserScript anInstantiation aDict |
- 	| aUserScript anInstantiation |
  	oldSelector = newSelector ifTrue: [^ self].
+ 	oldSelector numArgs == 0
- 
- 	oldSelector numArgs = 0
  		ifTrue:
+ 			[self class allInstancesDo:
+ 				[:aPlayer | | itsCostume |
+ 					anInstantiation _ aPlayer scriptInstantiationForSelector: oldSelector.
- 			[self class allSubInstancesDo:
- 				[:aPlayer | | itsCostume aDict |
- 					anInstantiation := aPlayer scriptInstantiationForSelector: oldSelector.
  					anInstantiation ifNotNil: [
+ 						newSelector numArgs == 0
- 						newSelector numArgs = 0
  							ifTrue:
  								[anInstantiation changeSelectorTo: newSelector].
+ 						aDict _ aPlayer costume actorState instantiatedUserScriptsDictionary.
+ 						itsCostume _ aPlayer costume renderedMorph.
- 						aDict := aPlayer costume actorState instantiatedUserScriptsDictionary.
- 						itsCostume := aPlayer costume renderedMorph.
  						itsCostume renameScriptActionsFor: aPlayer from: oldSelector to: newSelector.
  						self currentWorld renameScriptActionsFor: aPlayer from: oldSelector to: newSelector.
  						aDict removeKey: oldSelector.
  
+ 						newSelector numArgs  == 0 ifTrue:
- 						newSelector numArgs  = 0 ifTrue:
  							[aDict at: newSelector put: anInstantiation.
  							anInstantiation assureEventHandlerRepresentsStatus]]]]
  		ifFalse:
+ 			[newSelector numArgs == 0 ifTrue:
+ 				[self class allInstancesDo:
- 			[newSelector numArgs = 0 ifTrue:
- 				[self class allSubInstancesDo:
  					[:aPlayer |
+ 						anInstantiation _ aPlayer scriptInstantiationForSelector: newSelector.
- 						anInstantiation := aPlayer scriptInstantiationForSelector: newSelector.
  						anInstantiation ifNotNil: [anInstantiation assureEventHandlerRepresentsStatus]]]].
  
+ 	aUserScript _ self class userScriptForPlayer: self selector: oldSelector.
- 	aUserScript := self class userScriptForPlayer: self selector: oldSelector.
  
  	aUserScript renameScript: newSelector fromPlayer: self.
  		"updates all script editors, and inserts the new script in my scripts directory"
  
+ 	self removeScriptNamed: oldSelector.
- 	self class removeScriptNamed: oldSelector.
  	((self existingScriptInstantiationForSelector: newSelector) notNil and:
  		[newSelector numArgs > 0]) ifTrue: [self error: 'ouch'].
+ 
+ 	self updateScriptsCategoryOfViewers.
+ 
+ 	(self scriptEditorFor: newSelector) ifNotNilDo:
+ 		[:e | e updateHeader]!
- 		
- 	self updateAllViewersAndForceToShow: 'scripts'!

Item was changed:
  ----- Method: Player>>renameSlot:newSlotName: (in category 'slots-user') -----
  renameSlot: oldSlotName newSlotName: newSlotName
  	"Give an existing instance variable a new name"
  
+ 	^ self basicRenameSlot: oldSlotName newSlotName: newSlotName.
+ !
- 	self class renameSilentlyInstVar: oldSlotName to: newSlotName.
- 	self renameSlotInWatchersOld: oldSlotName new: newSlotName.
- 
- 	self updateAllViewers.
- 
- 	self presenter allExtantPlayers do:
- 		[:aPlayer | (aPlayer hasScriptReferencing: oldSlotName ofPlayer: self)
- 			ifTrue:
- 				[aPlayer noteRenameOf: oldSlotName to: newSlotName inPlayer: self]].
- 
- 	self presenter hasAnyTextuallyCodedScripts
- 		ifTrue:
- 			[self inform: 
- 'Caution!!  References in texutally coded scripts won''t be renamed.'].
- 
- 	^ true!

Item was changed:
  ----- Method: Player>>revealPlayerIn: (in category 'misc') -----
  revealPlayerIn: aWorld
  	"Reveal the receiver if at all possible in the world; once it's visible, flash its image for a bit, and leave it with its halo showing"
  
  	| aMorph |
+ 	(aMorph _ self costume) isInWorld ifTrue:
- 	(aMorph := self costume) isInWorld ifTrue:
  		[aMorph goHome.
  		self indicateLocationOnScreen.
+ 		aMorph owner ifNotNilDo: [:ownr | ownr layoutPolicy ifNil:
+ 			[aMorph comeToFront]].
  		aMorph addHalo.
  		^ self].
  
  	"It's hidden somewhere; search for it"
  	aWorld submorphs do:
  		[:m | (m succeededInRevealing: self) ifTrue:  "will have obtained halo already"
  			[aWorld doOneCycle.
  			self indicateLocationOnScreen.
  			^ self]].
  
  	"The morph is truly unreachable in this world at present.  So extract it from hyperspace, and place it at center of screen, wearing a halo."
  	aMorph isWorldMorph ifFalse:
  		[aWorld addMorphFront: aMorph.
  		aMorph position: aWorld bounds center.
+ 		aMorph addHalo]!
- 		aMorph addHalo]
- 	
- 	!

Item was added:
+ ----- Method: Player>>revertPage (in category '*Etoys-Squeakland-card/stack commands') -----
+ revertPage
+ 	"If there is a saved version of the current page, revert to it."
+ 
+ 	| bm |
+ 	((bm := costume renderedMorph) isKindOf: BookMorph) ifFalse: [^ self].
+ 	bm revertPage!

Item was changed:
  ----- Method: Player>>runScript: (in category 'scripts-kernel') -----
  runScript: aSelector
  	"Called from script-activation buttons.  Provides a safe way to run a script that may have changed its name"
  	(self respondsTo: aSelector) ifTrue:
  		[^ self triggerScript: aSelector].
  	self inform: 
+ ('Oops, object "{1}" no longer has
+ a script named "{2}".
+ It must have been deleted or renamed.' translated 
+ 	format: {self externalName.  aSelector})
+ !
- 'Oops, object "', self externalName, '" no longer has
- a script named "', aSelector, '".
- It must have been deleted or renamed.'!

Item was added:
+ ----- Method: Player>>sayGraphic: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ sayGraphic: aGraphic
+ self costume renderedMorph sayGraphic: aGraphic!

Item was added:
+ ----- Method: Player>>sayNumber: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ sayNumber: aNumber
+ self costume renderedMorph say: aNumber asString!

Item was added:
+ ----- Method: Player>>sayObject: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ sayObject: aPlayer
+ self costume renderedMorph sayObject: aPlayer!

Item was added:
+ ----- Method: Player>>sayText: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ sayText: aString
+ self costume renderedMorph say: aString!

Item was added:
+ ----- Method: Player>>scriptEditorForNoCng: (in category '*Etoys-Squeakland-scripts-kernel') -----
+ scriptEditorForNoCng: aSelector
+ 	"Answer the receiver's script editor for aSelector.  The script editor may be targeted to a sibiling of me.  Do not change the script editor's receiver."
+ 
+ 	| aScriptEditor |
+ 	aScriptEditor _ (self class userScriptForPlayer: self selector: aSelector) instantiatedScriptEditorForPlayer: self.  "creates an editor if none exists"
+ 	aScriptEditor bringUpToDate.
+ 	^ aScriptEditor!

Item was changed:
+ ----- Method: Player>>setAlpha: (in category 'slots-color components') -----
+ setAlpha: aFloat
+ 	"Set the alpha component of my costume, if appropriate."
- ----- Method: Player>>setAlpha: (in category 'slot getters/setters') -----
- setAlpha: alpha
- 	"Set the alpha of the color of my costume."
  
+ 	| aColor aValue |
+ 	aColor := self getColor.
+ 	aValue := (aFloat / 100 max: 0) min: 1.
+ 	self setColor: (Color
+ 		r: aColor red
+ 		g: aColor green
+ 		b: aColor blue
+ 		alpha: aValue)!
- 	| adjusted |
- 	adjusted := (alpha max: 0.0) min: 1.0.
- 	^ self setColor: (self getColor alpha: adjusted)!

Item was added:
+ ----- Method: Player>>setAttachmentEdge: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setAttachmentEdge: aSymbol
+ 	"Set the attachment edge to the given symbol"
+ 
+ 	^ costume renderedMorph attachmentEdge: aSymbol!

Item was added:
+ ----- Method: Player>>setAttachmentOffset: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setAttachmentOffset: aPoint
+ 	"Set the attachment offset, a point"
+ 
+ 	^ costume renderedMorph attachmentOffset: aPoint!

Item was added:
+ ----- Method: Player>>setBlue: (in category '*Etoys-Squeakland-slots-color components') -----
+ setBlue: aFloat
+ 	"Set the blue component of my costume, if appropriate."
+ 
+ 	| aColor aValue |
+ 	aColor := self getColor.
+ 	aValue := (aFloat / 100 max: 0) min: 1.
+ 	self setColor: (Color
+ 		r: aColor red
+ 		g: aColor green
+ 		b: aValue
+ 		alpha: aColor alpha)!

Item was added:
+ ----- Method: Player>>setBlur: (in category '*Etoys-Squeakland-sketch filters') -----
+ setBlur: aNumber
+ 	| number |
+ 	self costume renderedMorph isSketchMorph ifFalse:[^nil].
+ 	number := aNumber asInteger min:100 max:0.
+ 	self sendMessageToCostume: #filtersAdd: with: { #blur:form: . number}!

Item was added:
+ ----- Method: Player>>setBrightness: (in category '*Etoys-Squeakland-slots-color components') -----
+ setBrightness: aFloat 
+ 	"Set the brightness of my costume, if appropriate."
+ 
+ 	| aColor aValue |
+ 	aColor := self getColor.
+ 	aValue := (aFloat / 100 max: 0) min: 1.
+ 	self setColor: (Color
+ 		h: aColor hue
+ 		s: aColor saturation
+ 		v: aValue
+ 		alpha: aColor alpha)!

Item was added:
+ ----- Method: Player>>setBrightnessShift: (in category '*Etoys-Squeakland-sketch filters') -----
+ setBrightnessShift: aNumber
+ 	| number |
+ 	self costume renderedMorph isSketchMorph ifFalse:[^nil].
+ 	number := aNumber asInteger min:100 max:-100.
+ 	self sendMessageToCostume: #filtersAdd: with: { #brightnessShift:form: . number}!

Item was changed:
  ----- Method: Player>>setCharacterAtCursor: (in category 'slot getters/setters') -----
  setCharacterAtCursor: aCharOrString
  	"Insert the given character at my cursor position"
  
+ 	| aLoc aTextMorph aString charToUse newText |
+ 	aLoc _ (aTextMorph _ self costume renderedMorph) cursor.
+ 	charToUse _ (aString _ aCharOrString asString) size > 0
+ 		ifTrue: [aString first]
+ 		ifFalse: ['·'].
+ 	newText _ charToUse asString asText.
+ 	(aTextMorph text attributesAt: aLoc) do: [:att | newText addAttribute: att].
+ 	aTextMorph paragraph replaceFrom: aLoc to: aLoc with: newText displaying: true.
+ 	aTextMorph updateFromParagraph.  !
- 	| aLoc aTextMorph aString charToUse |
- 	aLoc := (aTextMorph := self costume renderedMorph) cursor.
- 	charToUse := (aString := aCharOrString asString) size > 0
- 		ifTrue:
- 			[aString first]
- 		ifFalse:
- 			['·'].
- 	aTextMorph paragraph replaceFrom: aLoc to: aLoc with: charToUse asString asText displaying: true.
- 	aTextMorph updateFromParagraph  !

Item was added:
+ ----- Method: Player>>setDateFormat: (in category '*Etoys-Squeakland-etoys-calendar') -----
+ setDateFormat: aSymbol
+ 	self costume renderedMorph setProperty: #dateFormat toValue: aSymbol!

Item was added:
+ ----- Method: Player>>setDay: (in category '*Etoys-Squeakland-etoys-calendar') -----
+ setDay: aNumber
+ 	"Set the day (of the month) as indicated."
+ 
+ 	^ self costume renderedMorph addDays: (aNumber - self getDay)!

Item was added:
+ ----- Method: Player>>setFishEye: (in category '*Etoys-Squeakland-sketch filters') -----
+ setFishEye: aNumber
+ 	| number |
+ 	self costume renderedMorph isSketchMorph ifFalse:[^nil].
+ 	number := aNumber asInteger  max:-10.
+ 	self sendMessageToCostume: #filtersAdd: with: { #fishEye:form: . number}!

Item was added:
+ ----- Method: Player>>setFlashCursor: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setFlashCursor: c
+ 	"Set the cursor"
+ 
+ 	^ self setCursor:c!

Item was added:
+ ----- Method: Player>>setForwardDirection: (in category '*Etoys-Squeakland-slots-bonus for geometry') -----
+ setForwardDirection: aNumber
+ 
+ 	self costume renderedMorph forwardDirection: aNumber!

Item was added:
+ ----- Method: Player>>setGifPlaying: (in category '*Etoys-Squeakland-MorphicExtras-AdditionalMorphs') -----
+ setGifPlaying: aBoolean
+ 	self setCostumeSlot: #setStepping: toValue: aBoolean
+ !

Item was added:
+ ----- Method: Player>>setGraphCursor: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setGraphCursor: c
+ 	"Set the cursor"
+ 
+ 	^ self setCursor:c!

Item was added:
+ ----- Method: Player>>setGraphic:rotationCenter: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setGraphic: aForm rotationCenter: aPoint
+ 	"Set the receiver's graphic as indicated"
+ 
+ 	| aMorph |
+ 	^ ((aMorph _ costume renderedMorph) isSketchMorph)
+ 		ifTrue:
+ 			[aMorph form: aForm rotationCenter: aPoint]
+ 		ifFalse:
+ 			[aMorph isPlayfieldLike
+ 				ifTrue: 
+ 					[aMorph backgroundForm: aForm]
+ 				ifFalse:
+ 					["what to do?"]]!

Item was added:
+ ----- Method: Player>>setGreen: (in category '*Etoys-Squeakland-slots-color components') -----
+ setGreen: aFloat
+ 	"Set the green component of my costume, if appropriate."
+ 
+ 	| aColor aValue |
+ 	aColor := self getColor.
+ 	aValue := (aFloat / 100 max: 0) min: 1.
+ 	self setColor: (Color
+ 		r: aColor red
+ 		g: aValue
+ 		b: aColor blue
+ 		alpha: aColor alpha)!

Item was changed:
  ----- Method: Player>>setHeading: (in category 'slot getters/setters') -----
  setHeading: newHeading
  	"Set the heading as indicated"
  
  	| aCostume |
+ 	aCostume _ self costume.
- 	aCostume := self costume.
  	aCostume isWorldMorph ifTrue: [^ self].
- 	(newHeading closeTo: aCostume heading) ifTrue: [^ self].
  	aCostume heading: newHeading.
+ 	aCostume _ self costume. "in case we just got flexed for no apparent reason"
- 	aCostume := self costume. "in case we just got flexed for no apparent reason"
  	(aCostume isFlexMorph and:[aCostume hasNoScaleOrRotation]) 
  		ifTrue:	[aCostume removeFlexShell]!

Item was added:
+ ----- Method: Player>>setHighlightColor: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setHighlightColor: aColor
+ 	"Set the costume's highlightColor."
+ 
+ 	costume highlightColor: aColor!

Item was added:
+ ----- Method: Player>>setHue: (in category '*Etoys-Squeakland-slots-color components') -----
+ setHue: aFloat
+ 	"Set the hue of my costume, if appropriate."
+ 
+ 	| aColor aValue |
+ 	aColor := self getColor.
+ 	aValue := aFloat \\ 360.
+ 	self setColor: (Color
+ 		h: aValue
+ 		s: aColor saturation
+ 		v: aColor brightness
+ 		alpha: aColor alpha)!

Item was added:
+ ----- Method: Player>>setHueShift: (in category '*Etoys-Squeakland-sketch filters') -----
+ setHueShift: aNumber 
+ 	| number |
+ 	self costume renderedMorph isSketchMorph ifFalse:[^nil].
+ 	number := aNumber asInteger min:360 max:-360.
+ 	self sendMessageToCostume: #filtersAdd: with: {#hueShift:form:. number}!

Item was added:
+ ----- Method: Player>>setImplicitSelfInTiles: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setImplicitSelfInTiles: aBoolean
+ 	"Set the value of the implicitSelfInTiles preference."
+ 
+ 	Preferences setPreference: #implicitSelfInTiles toValue: aBoolean!

Item was added:
+ ----- Method: Player>>setJulianDay: (in category '*Etoys-Squeakland-etoys-calendar') -----
+ setJulianDay: aNumber
+ 	"Set the selected date to be the one corresponding to the argument provided, interpreted as a julian day."
+ 
+ 	^ self costume renderedMorph date: (DateAndTime julianDayNumber: aNumber) asDate!

Item was changed:
  ----- Method: Player>>setLastKeystroke: (in category 'slot getters/setters') -----
  setLastKeystroke: aString
  	"Set the last keystroke fielded"
  
+ 	ActiveWorld lastKeystroke: aString!
- 	self setCostumeSlot: #lastKeystroke: toValue: aString!

Item was changed:
  ----- Method: Player>>setLength: (in category 'slot getters/setters') -----
  setLength: aLength
  	"Set the length of the receiver."
  
  	| cost lengthToUse |
+ 	cost _ self costume.
+ 	cost isWorldMorph ifTrue: [^self].
+ 	cost isLineMorph
- 
- 	self hasCostumeThatIsAWorld ifTrue:[^ self].
- 
- 	((cost := self costume) isLineMorph)
  		ifTrue:
  			[^ cost unrotatedLength: aLength].
+ 	lengthToUse _ cost isRenderer
- 	lengthToUse := cost isRenderer
  		ifTrue:
  			[aLength / cost scaleFactor]
  		ifFalse:
  			[aLength].
  	cost renderedMorph height: lengthToUse!

Item was added:
+ ----- Method: Player>>setLineCurved: (in category '*Etoys-Squeakland-vertices operation') -----
+ setLineCurved: aBoolean 
+ 	(aBoolean xor: self costume isCurve)
+ 				ifTrue: [self costume toggleSmoothing]!

Item was added:
+ ----- Method: Player>>setLineOpened: (in category '*Etoys-Squeakland-vertices operation') -----
+ setLineOpened: aBoolean 
+ 	(aBoolean xor: self costume isOpen)
+ 		ifTrue: [self costume makeOpenOrClosed]!

Item was added:
+ ----- Method: Player>>setLocation: (in category '*Etoys-Squeakland-points') -----
+ setLocation: val
+ 	"Set the receiver's location; expected to be called with a point argument"
+ 
+ 	| aCostume |
+ 	(val isKindOf: Point) ifFalse: [^ ScriptingSystem reportToUser: 'Expected a Point but instead got ' translated, val printString].
+ 	(aCostume _ self costume) isInWorld ifFalse: [^ self].
+ 	aCostume isWorldOrHandMorph ifTrue: [^ self].
+ 	aCostume owner isHandMorph ifTrue: [^ self].
+ 	^ aCostume x: val x y: val y!

Item was added:
+ ----- Method: Player>>setLocationOnGraph: (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ setLocationOnGraph: aPoint
+ 	"Set the location of the object to a given value, with respect to the axes found in the host playfield."
+ 
+ 	self setXOnGraph: aPoint x asFloat.
+ 	self setYOnGraph: aPoint y asFloat!

Item was added:
+ ----- Method: Player>>setMagnification: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setMagnification: aNumber
+ 	"Set the magnification"
+ 
+ 	^ self costume renderedMorph magnification: aNumber!

Item was added:
+ ----- Method: Player>>setMarksPerLegend: (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ setMarksPerLegend: aValue
+ 	self setCostumeSlot: #marksPerLegend: toValue: aValue!

Item was added:
+ ----- Method: Player>>setMonth: (in category '*Etoys-Squeakland-etoys-calendar') -----
+ setMonth: aNumber
+ 	"Set the month-number as indicated."
+ 
+ 	^ self costume renderedMorph addMonths: (aNumber - self getMonth)!

Item was changed:
  ----- Method: Player>>setNumberAtCursor: (in category 'slot getters/setters') -----
  setNumberAtCursor: aNumber
  	"Place the given number into the morph residing at my costume's current cursor position"
  
  	| renderedMorph aCostume |
+ 	aCostume _ self costume.
+ 	((renderedMorph _ aCostume renderedMorph) respondsTo: #valueAtCursor:) ifTrue: [^ renderedMorph valueAtCursor renderedMorph setNumericValue: aNumber]!
- 	aCostume := self costume.
- 	((renderedMorph := aCostume renderedMorph) respondsTo: #valueAtCursor:) ifTrue: [^ renderedMorph valueAtCursor setNumericValue: aNumber]!

Item was added:
+ ----- Method: Player>>setOpaque: (in category '*Etoys-Squeakland-MorphicExtras-AdditionalMorphs') -----
+ setOpaque: aBoolean
+ 	self setCostumeSlot: #isOpaque: toValue: aBoolean!

Item was added:
+ ----- Method: Player>>setPageControlsAtTop: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setPageControlsAtTop: aBoolean
+ 	"Set whether the book should show page controls at top."
+ 
+ 	| aBook |
+ 	^ (aBook _ self bookEmbodied)
+ 		ifNotNil:
+ 			[aBook pageControlsAtTop: aBoolean]!

Item was added:
+ ----- Method: Player>>setPageControlsShort: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setPageControlsShort: aBoolean
+ 	"Set whether the book is set for short page controls currently"
+ 
+ 	| aBook |
+ 	^ (aBook _ self bookEmbodied)
+ 		ifNotNil:
+ 			[aBook pageControlsShort: aBoolean]!

Item was added:
+ ----- Method: Player>>setPageControlsShowing: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setPageControlsShowing: aBoolean
+ 	"Answer whether the book is current showing page-controls"
+ 
+ 	| aBook |
+ 	^ (aBook _ self bookEmbodied)
+ 		ifNotNil:
+ 			[aBoolean
+ 				ifTrue:
+ 					[aBook showPageControls]
+ 				ifFalse:
+ 					[aBook hidePageControls]]!

Item was added:
+ ----- Method: Player>>setPasteUpCursor: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setPasteUpCursor: aNumber
+ 	"Set my costume's cursor to the given number"
+ 
+ 	^ self setCursor: aNumber!

Item was added:
+ ----- Method: Player>>setPasteUpGraphic: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setPasteUpGraphic: g
+ 	"Answer a form representing the receiver's primary graphic"
+ 
+ 	^ self setGraphic: g!

Item was changed:
  ----- Method: Player>>setPenDown: (in category 'pen') -----
  setPenDown: penDown
  	"Set the penDown state as indicated, to true or false"
  
  	| morph trailMorph tfm |
  	self actorState setPenDown: penDown.
+ 	((morph _ self costume) notNil and: [(trailMorph _ morph trailMorph) notNil and: [morph isWorldMorph not]])
- 	((morph := self costume) notNil and: [(trailMorph := morph trailMorph) notNil])
  		ifTrue:
+ 		[tfm _ morph owner transformFrom: trailMorph.
- 		[tfm := morph owner transformFrom: trailMorph.
  		trailMorph notePenDown: penDown forPlayer: self
  					at: (tfm localPointToGlobal: morph referencePosition)]
  !

Item was added:
+ ----- Method: Player>>setPixelsPerUnit: (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ setPixelsPerUnit: aNumber 
+ 	self setCostumeSlot: #pixelsPerUnit: toValue: aNumber!

Item was added:
+ ----- Method: Player>>setPrecisionFor:precision: (in category '*Etoys-Squeakland-slots-user') -----
+ setPrecisionFor: slotName precision: aNumber
+ | val |
+ (self slotInfo includesKey: slotName) 
+ 	ifTrue: 
+ 		["it's a user slot"
+ 
+ 		(self slotInfoAt: slotName) 
+ 			floatPrecision: (Utilities floatPrecisionForDecimalPlaces: aNumber).
+ 		self class allInstancesDo: 
+ 				[:anInst | 
+ 				aNumber == 0 
+ 					ifFalse: 
+ 						[((val := anInst instVarNamed: slotName asString) isInteger) 
+ 							ifTrue: [anInst instVarNamed: slotName asString put: val asFloat]].
+ 				anInst updateAllViewers]]
+ 	ifFalse: 
+ 		["it's specifying a preference for precision on a system-defined numeric slot"
+ 
+ 		self noteDecimalPlaces: aNumber forGetter: (Utilities getterSelectorFor: slotName).
+ 		self updateAllViewers]!

Item was changed:
  ----- Method: Player>>setRadialGradientFill: (in category 'slot getters/setters') -----
  setRadialGradientFill: aBoolean
  	"Setter for costume's radialGradientFill"
  
+ 	| fil |
+ 	(self isFillStyle: (fil := costume renderedMorph fillStyle)) ifTrue:
+ 		[fil isGradientFill ifTrue:
+ 			[fil isRadialFill ~~ aBoolean ifTrue:
+ 				[fil radial: aBoolean.
+ 				costume renderedMorph changed]]]!
- 	| aStyle |
- 	(aStyle := costume renderedMorph fillStyle) isGradientFill
- 		ifTrue:
- 			[aStyle isRadialFill ~~ aBoolean ifTrue:
- 				[aStyle radial: aBoolean.
- 				costume renderedMorph changed]]!

Item was added:
+ ----- Method: Player>>setRed: (in category '*Etoys-Squeakland-slots-color components') -----
+ setRed: aFloat
+ 	"Set the red component of my costume, if appropriate."
+ 
+ 	| aColor aValue |
+ 	aColor := self getColor.
+ 	aValue := (aFloat / 100 max: 0) min: 1.
+ 	self setColor: (Color
+ 		r: aValue
+ 		g: aColor green
+ 		b: aColor blue
+ 		alpha: aColor alpha)!

Item was added:
+ ----- Method: Player>>setRelativeScale: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setRelativeScale: aBoolean
+ 	costume relativeScale: aBoolean!

Item was added:
+ ----- Method: Player>>setRotationCenter: (in category '*Etoys-Squeakland-slots-bonus for geometry') -----
+ setRotationCenter: aPointOfCartesian 	
+ | morph world aPlayfield newPoint |
+ 	morph := self costume renderedMorph.
+ 	world := self costume world.
+ 	world
+ 		ifNil: [^ morph setRotationCenterFrom: aPointOfCartesian].
+ 	aPlayfield := morph referencePlayfield.
+ 	newPoint := aPlayfield isNil
+ 				ifTrue: [world cartesianOrigin x + aPointOfCartesian x @ (world cartesianOrigin y - aPointOfCartesian y)]
+ 				ifFalse: [aPlayfield cartesianOrigin x + aPointOfCartesian x @ (aPlayfield cartesianOrigin y - aPointOfCartesian y)].
+ 	(self costume isKindOf: TransformMorph)
+ 				ifTrue: [newPoint := self costume transform globalPointToLocal: newPoint].
+ 	morph setRotationCenterFrom: newPoint!

Item was added:
+ ----- Method: Player>>setRotationCenterX: (in category '*Etoys-Squeakland-slots-bonus for geometry') -----
+ setRotationCenterX: aNumber 
+ 	self setRotationCenter: aNumber @ self getRotationCenterY!

Item was added:
+ ----- Method: Player>>setRotationCenterY: (in category '*Etoys-Squeakland-slots-bonus for geometry') -----
+ setRotationCenterY: aNumber 
+ 	self setRotationCenter: self getRotationCenterX @ aNumber!

Item was added:
+ ----- Method: Player>>setSamplingRate: (in category '*Etoys-Squeakland-MorphicExtras-Widgets') -----
+ setSamplingRate: aSymbol
+ 	costume renderedMorph setSamplingRate: aSymbol!

Item was added:
+ ----- Method: Player>>setSaturation: (in category '*Etoys-Squeakland-slots-color components') -----
+ setSaturation: aFloat 
+ 	"Set the saturation of my costume, if appropriate."
+ 
+ 	| aColor aValue |
+ 	aColor := self getColor.
+ 	aValue := (aFloat / 100 max: 0) min: 1.
+ 	self setColor: (Color
+ 		h: aColor hue
+ 		s: aValue
+ 		v: aColor brightness
+ 		alpha: aColor alpha)!

Item was added:
+ ----- Method: Player>>setSaturationShift: (in category '*Etoys-Squeakland-sketch filters') -----
+ setSaturationShift: aNumber
+ 	| number |
+ 	self costume renderedMorph isSketchMorph ifFalse:[^nil].
+ 	number := aNumber asInteger min:100 max:-100.
+ 	self sendMessageToCostume: #filtersAdd: with: { #saturationShift:form: . number}!

Item was changed:
  ----- Method: Player>>setSecondColor: (in category 'slot getters/setters') -----
  setSecondColor: aColor
  	"Setter for costume's second color, if it's using gradient fill; if not, does nothing"
  
+ 	| aFillStyle aMorph toUse |
+ 
+ 	^ (aFillStyle _ (aMorph _ costume renderedMorph) fillStyle) isGradientFill
- 	| aFillStyle aMorph |
- 	^ (aFillStyle := (aMorph := costume renderedMorph) fillStyle) isGradientFill
  		ifTrue:
+ 			[toUse := (costume isWorldMorph and: [aColor isColor])
+ 				ifTrue:
+ 					[aColor alpha: 1.0]  "reject any translucency"
+ 				ifFalse:
+ 					[aColor].
+ 			aFillStyle lastColor: toUse forMorph: aMorph hand: ActiveHand]!
- 			[aFillStyle lastColor: aColor forMorph: aMorph hand: ActiveHand]!

Item was added:
+ ----- Method: Player>>setSectorAngle: (in category '*Etoys-Squeakland-MorphicExtras-AdditionalMorphs') -----
+ setSectorAngle: aNumber 
+ 	^ self sendMessageToCostume: #angle: with: aNumber!

Item was added:
+ ----- Method: Player>>setSectorRadius: (in category '*Etoys-Squeakland-MorphicExtras-AdditionalMorphs') -----
+ setSectorRadius: aNumber 
+ 	^ self sendMessageToCostume: #radius: with: aNumber!

Item was added:
+ ----- Method: Player>>setShowNegativeArrowHead: (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ setShowNegativeArrowHead: aBoolean 
+ 	self setCostumeSlot: #showNegativeArrowHead: toValue: aBoolean!

Item was added:
+ ----- Method: Player>>setShowPointer: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setShowPointer: aBoolean
+ 	"Set the value of my costume's showPointer"
+ 
+ 	^ self costume renderedMorph showPointer: aBoolean!

Item was added:
+ ----- Method: Player>>setShowZero: (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ setShowZero: aBoolean 
+ 	self setCostumeSlot: #showZero: toValue: aBoolean!

Item was added:
+ ----- Method: Player>>setShowingHandles: (in category '*Etoys-Squeakland-vertices operation') -----
+ setShowingHandles: aBoolean 
+ 	(aBoolean xor: self costume showingHandles)
+ 		ifTrue: [self costume toggleHandles]!

Item was added:
+ ----- Method: Player>>setSound: (in category '*Etoys-Squeakland-sound') -----
+ setSound: aSound 
+ 	self costume setProperty: #sound toValue: aSound!

Item was added:
+ ----- Method: Player>>setStarRatio: (in category '*Etoys-Squeakland-vertices operation') -----
+ setStarRatio: aInteger
+ 		| int float |
+ 	int := aInteger min: 100 max: 1.
+ 	float  := (100 / int) asFloat.
+ 	^ self costume starRatio: float!

Item was added:
+ ----- Method: Player>>setStepping: (in category '*Etoys-Squeakland-MorphicExtras-AdditionalMorphs') -----
+ setStepping: aBoolean
+ 	self costume setStepping:aBoolean
+ 
+ !

Item was added:
+ ----- Method: Player>>setTextColor: (in category '*Etoys-Squeakland-scripts-standard') -----
+ setTextColor: aColor
+ 	"Set the background color; the costume is presumed to be a text morph."
+ 
+ 	self costume renderedMorph selectionColor: aColor!

Item was added:
+ ----- Method: Player>>setTextCursor: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setTextCursor: c
+ 	"Set the cursor"
+ 
+ 	^ self setCursor:c!

Item was added:
+ ----- Method: Player>>setTimer: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setTimer: seconds
+ 	costume renderedMorph
+ 		setProperty:  #timerStart
+ 		toValue: Time millisecondClockValue - (seconds * 1000) asInteger!

Item was added:
+ ----- Method: Player>>setTrackPointer: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setTrackPointer: aBoolean
+ 	"Set the value of my costume's trackPointer"
+ 
+ 	^ self costume renderedMorph trackPointer: aBoolean!

Item was added:
+ ----- Method: Player>>setUnitsPerMark: (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ setUnitsPerMark: aValue
+ 	self setCostumeSlot: #unitsPerMark: toValue: aValue!

Item was added:
+ ----- Method: Player>>setUnitsPerTick: (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ setUnitsPerTick: aNumber 
+ 	self setCostumeSlot: #unitsPerTick: toValue: aNumber!

Item was added:
+ ----- Method: Player>>setUseFrameSize: (in category '*Etoys-Squeakland-MorphicExtras-WebCam') -----
+ setUseFrameSize: aBoolean
+ 	self setCostumeSlot:#setUseFrameSize: toValue:aBoolean!

Item was changed:
  ----- Method: Player>>setUseGradientFill: (in category 'slot getters/setters') -----
  setUseGradientFill: aBoolean
  	"Setter for costume's useGradientFill"
  
+ 	| fil |
+ 	^ (self isFillStyle: (fil := costume renderedMorph fillStyle))
- 	costume renderedMorph fillStyle isGradientFill
  		ifTrue:
+ 			[fil isGradientFill
+ 				ifTrue:
+ 					[aBoolean ifFalse: [costume renderedMorph useSolidFill]]
- 			[aBoolean ifFalse: [costume renderedMorph useSolidFill]]
  		ifFalse:
+ 			[aBoolean ifTrue: [costume renderedMorph useGradientFill]]]!
- 			[aBoolean ifTrue: [costume renderedMorph useGradientFill]]!

Item was added:
+ ----- Method: Player>>setVertexCursor: (in category '*Etoys-Squeakland-vertices operation') -----
+ setVertexCursor: anInteger 
+ 	self costume vertexCursor: anInteger
+ !

Item was added:
+ ----- Method: Player>>setVerticesCount: (in category '*Etoys-Squeakland-vertices operation') -----
+ setVerticesCount: aInteger 
+ 	self costume setVerticesCount: aInteger!

Item was added:
+ ----- Method: Player>>setVideoGraphic: (in category '*Etoys-Squeakland-slot getters/setters') -----
+ setVideoGraphic: g
+ 	"Answer a form representing the receiver's primary graphic"
+ 
+ 	^ self setGraphic: g!

Item was added:
+ ----- Method: Player>>setWebCamIsOn: (in category '*Etoys-Squeakland-MorphicExtras-WebCam') -----
+ setWebCamIsOn: aBoolean
+ 	self setCostumeSlot: #setWebCamIsOn: toValue: aBoolean!

Item was added:
+ ----- Method: Player>>setWebCamResolution: (in category '*Etoys-Squeakland-MorphicExtras-WebCam') -----
+ setWebCamResolution: aSymbol
+ 	costume renderedMorph setWebCamResolution: aSymbol!

Item was added:
+ ----- Method: Player>>setWhirl: (in category '*Etoys-Squeakland-sketch filters') -----
+ setWhirl: aNumber
+ 	| number |
+ 	self costume renderedMorph isSketchMorph ifFalse:[^nil].
+ 	number := aNumber truncated.
+ 	self sendMessageToCostume: #filtersAdd: with: { #whirl:form: . number}!

Item was changed:
  ----- Method: Player>>setWidth: (in category 'slot getters/setters') -----
+ setWidth: aWidth
- setWidth: aWidth 
  	"Set the width"
- 	
- 	| cost widthToUse |
  
+ 	| cost widthToUse |
+ 	cost _ self costume.
+ 	cost isWorldMorph ifTrue: [^ self].
+ 	cost isLineMorph
+ 		ifTrue:
+ 			[^ cost unrotatedWidth: aWidth].
+ 	widthToUse _ cost isRenderer
+ 		ifTrue:
+ 			[aWidth / cost scaleFactor]
+ 		ifFalse:
+ 			[aWidth].
+ 	cost renderedMorph width: widthToUse!
- 	self hasCostumeThatIsAWorld
- 		ifTrue: [^ self].
- 
- 	(cost := self costume) isLineMorph
- 		ifTrue: [^ cost unrotatedWidth: aWidth].
- 
- 	widthToUse := cost isRenderer
- 				ifTrue: [aWidth / cost scaleFactor]
- 				ifFalse: [aWidth].
- 
- 	cost renderedMorph width: widthToUse.
- !

Item was added:
+ ----- Method: Player>>setXAtCursor: (in category '*Etoys-Squeakland-vertices operation') -----
+ setXAtCursor: aNumber
+ 
+ 	^ self costume xAtCursor: aNumber!

Item was added:
+ ----- Method: Player>>setXOnGraph: (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ setXOnGraph: aNumber
+ 	"Set the x-on-graph coordinate as indicated.  If there is Horizontal Number Line in the same playfield, this is interpreted with reference to the position and scale of that number line; if not, this is no different from setX:"
+ 
+ 	| aCostume |
+ 	(aCostume _ self costume) isInWorld ifFalse: [^ self setX: aNumber].
+ 
+ 	(aCostume referencePlayfield findA: HorizontalNumberLineMorph) ifNotNilDo:
+ 		[:aNumberLine |
+ 			^ aNumberLine setXOnGraphFor: aCostume to: aNumber].
+ 	^ self getX!

Item was added:
+ ----- Method: Player>>setYAtCursor: (in category '*Etoys-Squeakland-vertices operation') -----
+ setYAtCursor: aNumber
+ 
+ 	^ self costume yAtCursor: aNumber!

Item was added:
+ ----- Method: Player>>setYOnGraph: (in category '*Etoys-Squeakland-morphicExtras-Charts') -----
+ setYOnGraph: aNumber
+ 	"Set the y-on-graph coordinate as indicated.  If there is Vertical Number Line in the same playfield, this is interpreted with reference to the position and scale of that number line; if not, this is no different from setY:"
+ 
+ 	| aCostume |
+ 	(aCostume := self costume) isInWorld ifFalse: [^ self setY: aNumber].
+ 	(aCostume referencePlayfield findA: VerticalNumberLineMorph) ifNotNilDo:
+ 		[:aNumberLine |
+ 			^ aNumberLine setYOnGraphFor: aCostume to: aNumber].
+ 
+ 	^ self setY: aNumber!

Item was added:
+ ----- Method: Player>>setYear: (in category '*Etoys-Squeakland-etoys-calendar') -----
+ setYear: aNumber
+ 	"Set the selected year as indicated."
+ 
+ 	self costume renderedMorph addMonths: 12 * (aNumber - self getYear)!

Item was added:
+ ----- Method: Player>>showNavigationBar (in category '*Etoys-Squeakland-misc') -----
+ showNavigationBar
+ 	"Show the navigation bar at the top of the screen"
+ 
+ 	| tab |
+ 	((tab := costume world findA: SugarNavTab) notNil)
+ 		ifTrue:
+ 			[tab collapsedMode
+ 				ifTrue:
+ 					[tab showNavBar]]!

Item was changed:
  ----- Method: Player>>shuffleContents (in category 'scripts-standard') -----
  shuffleContents
  	"Tell my costume to rearrange its submorphs randomly"
  
+ 	costume renderedMorph shuffleSubmorphs!
- 	costume shuffleSubmorphs!

Item was added:
+ ----- Method: Player>>shuffleVertices (in category '*Etoys-Squeakland-vertices operation') -----
+ shuffleVertices
+ 
+ 	self costume shuffleVertices!

Item was added:
+ ----- Method: Player>>stopAttaching (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ stopAttaching
+ 	self sendMessageToCostume: #target: with: nil!

Item was added:
+ ----- Method: Player>>stopButtonHit (in category '*Etoys-Squeakland-scripts-standard') -----
+ stopButtonHit
+ 	"The stop button was hit."
+ 
+ 	 costume renderedMorph stopButtonHit!

Item was added:
+ ----- Method: Player>>stopSayingOrThinking (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ stopSayingOrThinking
+ self costume renderedMorph stopSayingOrThinking!

Item was added:
+ ----- Method: Player>>tearOffAttachedLabeledWatcherFor: (in category '*Etoys-Squeakland-slots-user') -----
+ tearOffAttachedLabeledWatcherFor: aGetter 
+ 	"Open a following watcher for the given getter."
+ 
+ 	(FollowingWatcher new fancyForPlayer: self getter: aGetter) openInWorld!

Item was added:
+ ----- Method: Player>>tearOffAttachedWatcherFor: (in category '*Etoys-Squeakland-slots-user') -----
+ tearOffAttachedWatcherFor: aGetter 
+ 	"Open a following watcher for the given getter."
+ 
+ 	(FollowingWatcher new unlabeledForPlayer: self getter: aGetter) openInWorld!

Item was changed:
  ----- Method: Player>>tellAllSiblings: (in category 'scripts-standard') -----
  tellAllSiblings: aMessageSelector
  	"Send the given message selector to all my sibling instances, but not to myself"
  
  	Symbol hasInterned: aMessageSelector
  		ifTrue: [ :sel |
  	self belongsToUniClass
+ 		ifTrue: [self class allSubInstancesDo: 
+ 			[:anInstance | 
+ 			anInstance isInTrash ifFalse: [
+ 				anInstance ~~ self ifTrue: [ anInstance triggerScript: sel ]]]]
+ 		ifFalse: [(sel ~~ #emptyScript) ifTrue:
+ 				[ScriptingSystem reportToUser: ('Cannot "tell " ' translated, aMessageSelector, ' to ' translated, self externalName) ]]]!
- 		ifTrue: [self class allSubInstancesDo:
- 				[:anInstance | anInstance ~~ self ifTrue: [ anInstance triggerScript: sel ]]]
- 		ifFalse:
- 			[(sel ~~ #emptyScript) ifTrue:
- 				[ScriptingSystem reportToUser: ('Cannot "tell" ', aMessageSelector, ' to ', self externalName) ]]]!

Item was changed:
  ----- Method: Player>>tellSelfAndAllSiblings: (in category 'scripts-standard') -----
  tellSelfAndAllSiblings: aMessageSelector
  	"Send the given message selector to all my sibling instances, including myself"
  
  	Symbol hasInterned: aMessageSelector
  		ifTrue: [ :sel |
  	self belongsToUniClass
  		ifTrue: [self class allSubInstancesDo:
+ 			[:anInstance | 
+ 			anInstance isInTrash ifFalse: [
+ 				(anInstance respondsTo: sel) ifTrue:
+ 		[anInstance triggerScript: sel ]]]]
+ 		ifFalse: [(sel ~~ #emptyScript) ifTrue:
+ 				[ScriptingSystem reportToUser: ('Cannot "tell " ' translated, aMessageSelector, ' to ' translated, self externalName) ]]]!
- 				[:anInstance | anInstance triggerScript: sel ]]
- 		ifFalse:
- 			[(sel ~~ #emptyScript) ifTrue:
- 				[ScriptingSystem reportToUser: ('Cannot "tell" ', aMessageSelector, ' to ', self externalName) ]]]!

Item was added:
+ ----- Method: Player>>thinkGraphic: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ thinkGraphic: aGraphic
+ self costume renderedMorph thinkGraphic: aGraphic!

Item was added:
+ ----- Method: Player>>thinkNumber: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ thinkNumber: aNumber
+ self costume renderedMorph think: aNumber asString!

Item was added:
+ ----- Method: Player>>thinkObject: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ thinkObject: aPlayer
+ self costume renderedMorph thinkObject: aPlayer!

Item was added:
+ ----- Method: Player>>thinkText: (in category '*Etoys-Squeakland-Etoys-SpeechBubbles') -----
+ thinkText: aString
+ self costume renderedMorph think: aString!

Item was changed:
  ----- Method: Player>>tileReferringToSelf (in category 'misc') -----
  tileReferringToSelf
- 	"answer a tile that refers to the receiver"
  
+ 	| aTile |
+ 	aTile _ TileMorph new setToReferTo: self.
- 	| aTile  nn tile |
- 	Preferences universalTiles ifTrue:
- 		[nn := self externalName. 	"name it, if necessary, and put in References"
- 		(References includesKey: nn asSymbol) ifFalse: [
- 			 References at: nn asSymbol put: self].
- 		tile := SyntaxMorph new parseNode: 
- 			(VariableNode new name: nn key: nn code: nil).
- 		tile layoutInset: 1; addMorph: (tile addString: nn special: false).
- 		tile color: (SyntaxMorph translateColor: #variable).
- 		tile extent: tile firstSubmorph extent + (2 at 2).
- 		^ tile].
- 
- 	aTile := TileMorph new setToReferTo: self.
  	aTile updateWordingToMatchVocabulary.
  	^ aTile!

Item was changed:
  ----- Method: Player>>triggerScript: (in category 'customevents-custom events') -----
  triggerScript: aSymbol 
  	"Perform the script of the given name,
  	which is guaranteed to exist.
  	However, it's possible that the script may still result in a DNU,
  	which will be swallowed and reported to the Transcript."
  
  	^ [[self perform: aSymbol]
  		on: GetTriggeringObjectNotification do: [ :ex |
  			ex isNested
  				ifTrue: [ ex pass ]
  				ifFalse: [ ex resume: self ]]]
  		on: MessageNotUnderstood
  		do: [:ex | 
  			ScriptingSystem
  				reportToUser: (String
  						streamContents: [:s | s nextPutAll: self externalName;
+ 								 nextPutAll: ': exception in script ' translated;
- 								 nextPutAll: ': exception in script ';
  								 print: aSymbol;
  								 nextPutAll: ' : ';
  								 print: ex]).
  			ex return: self
  			"ex pass"]!

Item was changed:
  ----- Method: Player>>uniqueNameForReference (in category 'viewer') -----
  uniqueNameForReference
- 	"Answer a unique name for referring to the receiver"
  
+ 	^ self costume referenceWorld uniqueNameForReferenceFor: self.
- 	| itsReferent |
- 	self flag: #deferred.  "The once-and-maybe-future ObjectRepresentativeMorph scheme is for the moment disenfranchised"
- 
- 	"(costume isKindOf: ObjectRepresentativeMorph) ifTrue:
- 		[((itsReferent := costume objectRepresented) isKindOf: Class)
- 			ifTrue:
- 				[^ itsReferent name].
- 		itsReferent == Smalltalk ifTrue: [^ #Smalltalk].
- 		itsReferent == ScriptingSystem ifTrue: [^ #ScriptingSystem]]."
- 
- 	^  super uniqueNameForReference
- 
  !

Item was changed:
  ----- Method: Player>>unusedScriptName (in category 'misc') -----
  unusedScriptName
  	"answer a name of the form 'scriptN', where N is one higher than the highest-numbered similarly-named script"
  
+ 	| defaultStem highestThus aPair |
+ 	defaultStem := self defaultScriptName.
- 	| highestThus |
  	highestThus := 0.
  	self class tileScriptNames do:
+ 		[:aName |
- 		[:aName | | aPair |
  			aPair := (aName copyWithout: $:) stemAndNumericSuffix.
+ 			aPair first = defaultStem ifTrue: [highestThus := highestThus max: aPair last]].
+ 	^ (defaultStem, (highestThus + 1) printString) asSymbol!
- 			aPair first = 'script' translated ifTrue: [highestThus := highestThus max: aPair last]].
- 	^ ('script' translated, (highestThus + 1) printString) asSymbol!

Item was added:
+ ----- Method: Player>>updateScriptsCategoryOfViewers (in category '*Etoys-Squeakland-misc') -----
+ updateScriptsCategoryOfViewers
+ 	"Update scripts category of all Viewers affeced by a change to the scripts of the receiver."
+ 
+ 	self allOpenViewersOnReceiverAndSiblings do:
+ 		[:aViewer |
+ 			aViewer updateScriptsCategory.
+ 			aViewer isInWorld ifTrue:
+ 				[aViewer assureScriptsCategoryShows]]!

Item was changed:
  ----- Method: Player>>usableMethodInterfacesIn: (in category 'slots-kernel') -----
  usableMethodInterfacesIn: methodInterfaceList
  	"Filter the list given by methodInterfaceList, to remove items inappropriate to the receiver"
  
  	self hasCostumeThatIsAWorld ifTrue:
+ 		"Formerly we had been hugely restrictive here, but let's try the other extreme for a while..."
+ 		[^ methodInterfaceList reject: [:anInterface |
+ 			#(getShadowColor getDropShadow getRoundedCorners getBorderStyle getBorderColor getBorderWidth)  includes: anInterface selector]].
- 		[^ methodInterfaceList select: [:anInterface |
- 			#(append: prepend: beep: clearTurtleTrails doScript: getColor "color" getCursor "cursor" deleteCard doMenuItem emptyScript firstPage goToFirstCardInBackground goToFirstCardOfStack goToLastCardInBackground goToLastCardOfStack goToNextCardInStack goToPreviousCardInStack initiatePainting insertCard  liftAllPens lowerAllPens trailStyleForAllPens: arrowheadsOnAllPens noArrowheadsOnAllPens getMouseX getMouseY "mouseX mouseY" pauseScript: reverse roundUpStrays shuffleContents startScript: stopScript: unhideHiddenObjects getValueAtCursor "valueAtCursor"
- startAll: pauseAll: stopAll:  
- viewAllMessengers clobberAllMessengers openAllScriptsTool handScriptControlButtons viewAllReferencedObjects jumpToProject: #getLength #getWidth )
  
- includes: anInterface selector]].
- 
  	self hasAnyBorderedCostumes ifTrue: [^ methodInterfaceList].
  
  	^ self hasOnlySketchCostumes
  		ifTrue:
+ 			[methodInterfaceList select: [:anInterface | (#(getColor getSecondColor getBorderColor getBorderWidth getBorderStyle  getRoundedCorners getUseGradientFill getRadialGradientFill  getRed getGreen getBlue getAlpha getHue getBrightness getSaturation ) includes: anInterface selector) not]]
- 			[methodInterfaceList select: [:anInterface | (#(getColor getAlpha getSecondColor getBorderColor getBorderWidth getBorderStyle getRoundedCorners getUseGradientFill getRadialGradientFill ) includes: anInterface selector) not]]
  		ifFalse:
  			[methodInterfaceList select: [:anInterface | (#(getBorderColor getBorderWidth) includes: anInterface selector) not]]!

Item was added:
+ ----- Method: Player>>useBlueprintCanvas (in category '*Etoys-Squeakland-misc') -----
+ useBlueprintCanvas
+ 	"Tell my costume to use a blueprint canvas."
+ 
+ 	costume world useBlueprintCanvas: true!

Item was added:
+ ----- Method: Player>>useGrayLook (in category '*Etoys-Squeakland-scripts-standard') -----
+ useGrayLook
+ 	"Install the standard 'gray look' for the sugar nav bar."
+ 
+ 	costume makeGray!

Item was added:
+ ----- Method: Player>>useGreenLook (in category '*Etoys-Squeakland-scripts-standard') -----
+ useGreenLook
+ 	"Install the standard 'green look' for the sugar nav bar."
+ 
+ 	costume makeGreen!

Item was added:
+ ----- Method: Player>>useNormalCanvas (in category '*Etoys-Squeakland-misc') -----
+ useNormalCanvas
+ 	"Tell my world to use a normal canvas."
+ 
+ 	costume world useBlueprintCanvas: false!

Item was changed:
  ----- Method: Player>>wearCostumeOf: (in category 'costume') -----
  wearCostumeOf: anotherPlayer
  	"Put on a costume similar to the one currently worn by anotherPlayer"
  
+ 	| aForm itsMorph |
+ 	aForm := anotherPlayer getGraphic deepCopy.
+ 	aForm offset: 0 @ 0.
+ 	itsMorph := anotherPlayer costume.
+ 	costume rotationStyle: itsMorph rotationStyle.
+ 	"costume forwardDirection: itsMorph forwardDirection."
+ 	self setGraphic: aForm rotationCenter: itsMorph rotationCenter
+ 
+ 
+ "	self renderedCostume: (anotherPlayer costume renderedMorph asWearableCostumeOfExtent: self costume extent) remember: anotherPlayer costume shouldRememberCostume Unmatched comment quote ->s"!
- 	self renderedCostume: (anotherPlayer costume renderedMorph asWearableCostumeOfExtent: self costume extent) remember: anotherPlayer costume shouldRememberCostumes!

Item was added:
+ ----- Method: PlayerSurrogate>>copyName (in category '*Etoys-Squeakland-menu') -----
+ copyName
+ 	"Copy the internal name of my referent to the clipboard."
+ 
+ 	 Clipboard clipboardText: playerRepresented externalName!

Item was added:
+ ----- Method: PlayerSurrogate>>destroyThisObject (in category '*Etoys-Squeakland-as yet unclassified') -----
+ destroyThisObject
+ 	"Make an effort to remove this object."
+ 
+ 	playerRepresented isInTrash
+ 		ifTrue:
+ 			[^ self inform: 'Already in the Trash' translated].
+ 	playerRepresented costume slideToTrash: nil!

Item was added:
+ ----- Method: PlayerSurrogate>>forciblyRenamePlayer (in category '*Etoys-Squeakland-as yet unclassified') -----
+ forciblyRenamePlayer
+ 	"Allow the receiver to seize a name already nominally in use in the project."
+ 
+ 	| current reply assoc currentlyBearingName newNameForHim |
+ 	current := playerRepresented knownName.
+ 	reply := FillInTheBlank request: 'Type the name you insist upon' translated initialAnswer: current.
+ 	reply isEmptyOrNil ifTrue: [^ self].
+ 	Preferences uniquePlayerNames ifFalse: [^ self costume renameTo: reply].
+ 	reply := (reply asIdentifier: true) asSymbol.
+ 	reply = current ifTrue: [^ self inform: 'no change' translated].
+ 
+ 	(assoc := ActiveWorld referencePool bindingOf: reply)
+ 		ifNotNil:
+ 			[currentlyBearingName := assoc value.
+ 			newNameForHim := Utilities keyLike: reply satisfying:
+ 				[:aName | (ActiveWorld referencePool includesKey:aName) not].
+ 			currentlyBearingName renameTo: newNameForHim].
+ 	playerRepresented renameTo: reply.
+ 	assoc
+ 		ifNil:
+ 			[self inform: 'there was no conflict; this object is now named ' translated, reply]
+ 		ifNotNil:
+ 			[self inform: 'okay, this object is now named
+ 'translated, reply, '
+ and the object formerly known by this name
+ is now called
+ 'translated, newNameForHim]!

Item was added:
+ ----- Method: PlayerSurrogate>>inspectPlayer (in category '*Etoys-Squeakland-menu') -----
+ inspectPlayer
+ 	"Inspect the player I represent."
+ 
+ 	playerRepresented inspectWithLabel: playerRepresented printString!

Item was added:
+ ----- Method: PlayerSurrogate>>playerButtonHit (in category '*Etoys-Squeakland-menu') -----
+ playerButtonHit
+ 	"The user clicked on the menu icon."
+ 
+ 	| aMenu aString |
+ 	aMenu := MenuMorph new defaultTarget: self.
+ 	aString := playerRepresented uniqueNameForReference.
+ 	aMenu addTitle: aString.
+ 	aMenu addTranslatedList: #(
+ 		('where is this object?'  revealThisObject)
+ 		('open viewer for this object'	viewerForThisObject)
+ 		('tile for this object' handMeATile)
+ 		-
+ 		('destroy this object' destroyThisObject)
+ 		-
+ 		('rename object' renamePlayer)
+ 		('forcibly rename object' forciblyRenamePlayer 'If you want to give this object a name which conflicts with the name of some other object in the project, use this command.  The other object with the same name will in the process be given a different name.')
+ 		-
+ 		('copy object''s name to clipboard' copyName)
+ 		('inspect object'	inspectPlayer)
+ ) translatedNoop.
+ 	aMenu popUpInWorld!

Item was changed:
  ----- Method: PlayerSurrogate>>rebuildRow (in category 'accessing') -----
  rebuildRow
  	"Rebuild the row"
  
+ 	| aThumbnail aTileButton aViewerButton aMenuButton |
- 	| aThumbnail aTileButton aViewerButton |
  	self removeAllMorphs.
  	self layoutInset: 2; cellInset: 3.
  	self beTransparent.
+ 	aThumbnail _ ThumbnailForAllPlayersTool new objectToView: playerRepresented viewSelector: #graphicForViewerTab.
+ 
+ 	aMenuButton _ IconicButton new labelGraphic: (ScriptingSystem formAtKey: #MenuIcon).
- 	aThumbnail := ThumbnailForAllPlayersTool new objectToView: playerRepresented viewSelector: #graphicForViewerTab.
- 	aThumbnail setBalloonText: 'Click here to reveal this object' translated.
- 	self addMorphBack: aThumbnail.
- 	aThumbnail on: #mouseUp send: #beRevealedInActiveWorld to: playerRepresented.
- 	
- 	"aMenuButton := IconicButton new labelGraphic: Cursor menu.
  	aMenuButton target: self;
  		actionSelector: #playerButtonHit;
  
  		color: Color transparent;
  		borderWidth: 0;
  		shedSelvedge;
  		actWhen: #buttonDown.
+ 	aMenuButton setBalloonText: 'Press here to get a menu' translated.
+ 	self addMorphBack: aMenuButton.
+ 
+ 	aThumbnail setBalloonText: 'Click here to reveal this object' translated.
+ 	self addMorphBack: aThumbnail.
+ 	aThumbnail on: #mouseUp send: #beRevealedInActiveWorld to: playerRepresented.
+ 
+ 	aViewerButton _ IconicButton new labelGraphic: (ScriptingSystem formAtKey: #'LargeHalo-View').
- 	aMenuButton setBalloonText: 'Press here to get a menu'.
- 	self addMorphBack: aMenuButton."
- 	aViewerButton := IconicButton new labelGraphic: (ScriptingSystem formAtKey: #Viewer).
  	aViewerButton color: Color transparent; 
  			actWhen: #buttonUp;
  			actionSelector: #beViewed; target: playerRepresented;
  			setBalloonText: 'click here to obtain this object''s Viewer' translated;
  			color: Color transparent;
  			borderWidth: 0;
  			shedSelvedge.
  
  	self addMorphBack: aViewerButton.
  
+ 	aTileButton _ IconicButton  new borderWidth: 0.
- 	aTileButton := IconicButton  new borderWidth: 0.
  	aTileButton labelGraphic: (TileMorph new setToReferTo: playerRepresented) imageForm.
  	aTileButton color: Color transparent; 
  			actWhen: #buttonDown;
  			actionSelector: #tearOffTileForSelf; target: playerRepresented;
  			setBalloonText: 'click here to obtain a tile that refers to this player.' translated.
  	self addMorphBack: aTileButton.
  
+ "	aNameMorph _ UpdatingStringMorph new
- "	aNameMorph := UpdatingStringMorph new
  		useStringFormat;
  		target:  playerRepresented;
  		getSelector: #nameForViewer;
  		setNameTo: 'name';
  		font: ScriptingSystem fontForNameEditingInScriptor.
  	aNameMorph putSelector: #setName:.
  		aNameMorph setProperty: #okToTextEdit toValue: true.
  	aNameMorph step.
  	self addMorphBack: aNameMorph.
  	aNameMorph setBalloonText: 'Click here to edit the player''s name.'.	"
- 
  	!

Item was added:
+ ----- Method: PlayerSurrogate>>renamePlayer (in category '*Etoys-Squeakland-menu') -----
+ renamePlayer
+ 	"Rename the player I represent."
+ 
+ 	| result |
+ 	result := FillInTheBlank request: 'Type new name:' translated
+ 		initialAnswer: playerRepresented knownName.
+ 	result isEmptyOrNil ifFalse:
+ 		[playerRepresented tryToRenameTo: result]!

Item was changed:
  ----- Method: PlayerType>>addExtraItemsToMenu:forSlotSymbol: (in category 'tiles') -----
  addExtraItemsToMenu: aMenu forSlotSymbol: slotSym
  	"If the receiver has extra menu items to add to the slot menu, here is its chance to do it"
  
  	aMenu add: 'tiles to get...' translated selector: #offerGetterTiles: argument: slotSym.
+ 	aMenu balloonTextForLastItem: 'useful shortcut for obtaining the value of a variable belonging to the player that is the current value of this player-valued variable'!
- 	aMenu add:  'reveal me' translated target: aMenu defaultTarget selector: #revealPlayerNamed:in: argumentList: { slotSym. ActiveWorld}.!

Item was added:
+ Object subclass: #PlayingCard
+ 	instanceVariableNames: 'cardNo suit suitNo cardForm'
+ 	classVariableNames: 'ASpadesLoc CachedBlank CachedDepth CardSize FaceForms FaceLoc FaceSuitLoc MidSpotLocs NumberForms NumberLoc SuitForms SuitLoc TopSpotLocs'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!
+ 
+ !PlayingCard commentStamp: '<historical>' prior: 0!
+ This class assembles card images from their parts.  The images are broken down so that the image data is very compact, and the code is written to display properly at all color depths.  The method imageData may be removed after initialization to save space, but must be re-built prior to fileOut if you wish to retain the images.
+ 
+ To use in morphic, one can simply put these forms into ImageMorphs (see example in buildImage).  However it should be possible to define a subclass of ImageMorph that simply creates playingCard instances on the fly whenever the image form is needed.  This would avoid storing all the images.!

Item was added:
+ ----- Method: PlayingCard class>>imageData (in category 'all') -----
+ imageData ^ 'AgQALwAlAAAAAIDjaN4VEeFDEREREBIiIiIiIiIiIYiBiIGIgYiIiIgSIiIiEBIiIiIREiIiIhgRGBEYERiBiIEiIiIiEBIiIiERESIiIiFEREREREQRGBIiIiIiEBIiIhERERIiIiIRERERERFEQSIiIiISEBIiIhERERIiIiIRERERERERESIiIiEREBIiIhERERIiIiESIiIiISERESIiIhIUEBIiIiERESIiIhISIiIiISEhESIiIhIUEBIiERIREhESIhIRESERESEhISIiIhIUEBIhERERERERIhEREhESESEhISIiIhIUEBIREREREREREhISIhIiISEhISIiIhIUEBIREREREREREhISIhIiISEhISIiIhIUEBIREREREREREhISIhIiISEhISIiIhIUEBIhEREhIRERIhISIREiISEhISIiIhIUEBIiERIKISIREuIfIhEhISEhESIiEhQQEiIiIhESIiIhERIhESIhISEhIhIiEhQQEiIiIRERIiIiEhIiIiIhISISEhEiEhQQEiIiIiIiIiIREhISIhIRISERIRQREhQQEiIiIiIiIiEiEhISEhISESEhIUREEhQQEiIiIiIiIiEhIhISEhIRISIhFIREEhQQEiIiIiIiEREiISEhQSEiFBEUSIREEhQQEiIiIiERERERERQURBQRREQURESBEhQQEiIiERRBiBEhGBFERERERBFIREQSEhQQEiIhREREGIEREYERREREERSIRIEiEhQQEiEUJCQkIYgRIYGBEUQRGBRERBIhEhQQEhEURERERBiBERgYERERgUREgSIREhQQFBESQkJCQkGIERgYgREYgUhEQSEREhQQFBEUREREREEYQRGBGBGBFIhEEiEREhQQFBEUJCQkJCERhBGBiIiIFERIEhFBEhQQFBEUREQREUEUGBEYERQRFEREEhEREhQQEYgRQkEiIhEREYEYGIiIFISBIhFBEhQQGIiBRBIhEiEUQYEYERQRSIRBIREREhQQEYgRFBIUQSERERgRgYiBRESBIRERERQQERERERIUQSEURBgRgRQRRERBIREiEiEQEUQRERIhEiERERGBgYiBRISBIRIiIREQEREREREiIhERERERERERSIRBIRIRIiEQESISIREREUQSIiFEQRERFESBIRIiEREQBAAvACUAAAAAgONk3hURExERERAYiIiIiIQRQhISESEJIuNPIiIiEBGIiIiIhBFCESEhESIiIiIiIhESIiIiEBIYiIgRhBFCEiESESIiIiIiIRERIiIiEBIhiIgYRBFCEhIhISIiIiIiEREREiIiEBIhiIiEQRRCESIiERIiIiIiEREREiIiEBIiGIiEQRQiEiIiIRIiIiIiEREREiIiEBIiGBGEERQiERIREUEiIiIiIRERIiIiEBIiGBhEEUQhIRIhEUEiIiIREhESERIiEBIhiIRBEUIhIiEiIRQSIiEREREREREiEBIhiIRBFEISIiEiIRQSIhERERERERESEBIYEUQRRCISIiEiIRFBIhERERERERESEBGIFEERQiEiIhESIUFEEhERERERERESEBIRRBEUQiEiIiIiIUQUQSERESEhEREiEBIiERFEIhQSIhESERQRRBIREiEiERIiEBIiIRFCIhFBIiEiERFBFEEiIhESIiIiEBIiERRCIRgREiIhgREUEUQSIRERIiIiEBIhEUQhFISBgREYFIhBRBFBIiIiIiIiEBIRFEISIUhEgYGESIQSFEEUEiIRIiIiEBERQRERERSIRERIiEEREUQUEiFEESIiEBEUiIERESEUiIiIRBISGBQUEhQRRBIiEBGIGIgSISIRFBEUESIRgYFBIUREQSIiEBiIgYGBISERIURBIREYiBESIhEUEhESEBRERBiIEREhIUhBISGBgRGBIiIhIYiBEBREREGIGBEhIURBIRiIFBGBEhESGIESEBREREQRiIgRERQREYGBRBGBEYiBEREiEBgYGBREEYGIiBEYiIERhBGBGIgSEiISEBGBgYGBRBEYiIiIgRERhEEYERESIRESEBgYEREREUSBERERERgRhEERRBQRISISEBGBGIiIiBFEgREYEYEYREQUIkERERESEBgYiBERGIgUQRERgYEYREGBQkQUEiISEBGIERgYERiBSBERGBEYRBiBFERBEREiEBQRGBgYGBGIFBERgYEYRBgYgUIkFBIiEBRBGBEREYgYFIEYERgYQYgRERQkQREiEBQkEUREQREYgUGBEREYQYGIFEFERBQSEBQiQUIiRBiBgRERGIEREYERFCIUIkEREBFERBIRJBERgURBREQYgYGIFCEhQkQUEAQALwAlAAAAAIDjaN4VEeE/EREREBIiIiEUFEFEQUFEFBREFBIiIiIiIiIiEBEiIiIRQUQUQUFEFBRBQSIiIhESIiIiEBQSIiIhFBRBEUERFBEUEiIiIRERIiIiEBRBIiIiFERERERERERBEiIiEREREiIiEBREEiIiERERERERERERIiIiEREREiIiEBERESIiGBIiIiIhgYGBIiIiEREREiIiEBiIEiIiGBIiIiIhgYGBIiIiIRERIiIiEBGIEiIiGBERIREhgYGBIiIREhESERIiEBiIEiIiGBESERIRgYGBIiEREREREREiEBGIEiIiGBIiEiIhgYGBIhERERERERESEBiIEiIhGBIiEiIhgYGBIhERERERERESEBGIEiIYGBIiEiIhgYGBIhERERERERESEBiIEiIYGBIhESIhgYGBEiERESEhEREiEAoRGBIi4iMiIiGBgRiBIhESISIREiIQGIgSIYgYISERIiGBEYgRIiIiERIiIiIQERgSIYGIESIiIhGBiBERESIhEREiIiIQGIgSIYiBFBIiIUGBGBESEhIiIiIiIiIQGIgRIhEUFEERFEQYiBEhEkESIiIiIiEQEYEiEUFBFERBFEQREREYEkRBEiIiIhgQEhIiIRQUFIhBEUESIRIYEkSEIRIiIYgQERERIUFBFERBIREiESGIEkiIQhERGIgQEiESIRQUFIhBIhIhEhiIEohIghERGIgQERgSIUFBFERBEiIRIYgREkiIQhERGIgQEhgSIRQUFIhBESESQYiIEkSEQhERGIgQEYgSIUFBFERBIREkGIEREkREQhERGIgQEhgSFBQRFIhBEhIRiIiIEkSEQhERGIgQEYgREUERFERBQSFBgYEREkiIQhERGIgQGIgRERERSIQYFBQYiIiIEohIghERGIgQGIgRIREhREQRgUGBgREREkiIQRFEGIgQGIgSIhIhSIQYiBiIiIiIEkSEQUSIGIgQGIgSEiIRREQREYgYEREREhERREREGIgQGIgRISEhSIQYiIiIiIiIESIUSIREGIgQGIgSEhIRREQRhBgRGBSBIiFEREQRGIgQGIgRISEkiEGIgUEiIUESIiFIhEESGIgQGIgSEhIUREEYiBIREhIiIhRERBISGIgQGIgRISEUiEGBESFEQSEiIRSIQSEhGIgQBAAvACUAAAAAgONg3hUR4dsREREQEiIiIiIiIhiIgYiBiIiIiIiIgSIiIiIQEiIiIkIiIiGIERgRGIGIiIiIEiIREiEQEiIiJEQiIiIURERESBEYgYiBIiGBIhQQEiIiRERCIiIRERERFERIERgRIhiBIhQQEiIpRERJIiIhEREREREUREQSIhiBIhQQEiKUREREkiIhIiIiESERERESIYgSEREQEiKUREREkiIhIRIiEhIRERESIYEiQkIQEiRERERERCIhESEiEhISEhISIRIiQkIQEkREREREREImIiIiEhISEhISIYEiEhIQEiRERERERCISIiIiEhISEhISIYgSEREQEiKUREREkiEiIiIiEhISEhISIhiBIhQQEiKUREREkiEWIiIiISEhISEhIhiBIhQQEiIpRERJIiIhERISISEhISEhIiGBIhQQEiIiRERCIiIhIhESIhISEhISEiIREhQQEiIiJEQiIiIiESIiIiEhISEhISIiIhQQEiIiIkIiIiIhIiIiERIhISEhISIiIhQQEiERIiIiIiIhEiIhIiEhISEhISIiIhQQEhISERIiIhEhIiIhIRIhISEhISIiIhQQEhEhISEiISESIiIhEiISEhISEiIiIhQQERISEhISISIiIiIiCRFbIiIUEBEhISIiIRgSIiIRERERiBIiGIEiEREREBISEiIhERGBEREREREhGIEhEYgSIYgSEBIhIhERFEEYERRBERIRIYgREhiBIRiBEBIiEUEYFEERgUFEEQkR4ScRIYIQEhFEREGBEhGBRBQRiIiIiIiIiBEREREQEUREQRgYEUQRFEESEhISEhISIYEREREQFERBGIiBgUQYERIiIiIiIiIiGBRBEiEQFEEYiIERGBEYEiIRERERERIhgYFEESEQFBiIgRERGBIYEhGIiIiIiBIYEUgUQREQEYiBEREhGBEYEYgRERERgSGBiBSBRBEQGIgRESIhEYERGBERREQYEiGBGIFIFEEQGIFEERIiEYERgRFEREQYEhgREYEREREQGBQUQREiEYERgRERERGBIhgRERSBSBQQEYhBRBESERgRgUREREGBIYERGBSBSBQQEUiEFEERIRgRgRERERgSIYEUSBQREREQFEFIhBERERERGBIiIhgRERERERSIQUQQBAAvACUAAAAAgONo3hUR4bsREREQEhiIiIiIFEEiEhIRgSIiIiIiIiIiIiIQEiGIiIEYFEEhISEhiBIiIiIiIkIiIiIQEiGIiIiIFEEiIRIRGBIiIiIiJEQiIiIQEiIYiIEYFEEiEiEhEYEiIiIiRERCIiIQEiIYiIiBFBIRIiIRERgSIiIpRERJIiIQEiIYiBGBRBEiIiIhQRgSIiKUREREkiIQEiIYiIgRQSIREhERQRGBIiKUREREkiIQEiIYgRgUQSEhESERRBGBIiRERERERCIQEiIYiIEUESIiISIhRBEYEkREREREREIQEiGIEYFEEhIiISIhREEYEiRERERERCIQEiGIiBFBISEiISIhREEYEiKUREREkiIQEhiBgRRBIRIiERIhREEYEiKUREREkiIQEiGIEUQSISIiIiIhREQRgSIpRERJIiIQEiIRFEEiFBIiERIYFEQRgSIiRERCIiIQEiIhRBIiEUEiISIYEUQRgSIiJEQiIiIQEiIUQSIhiBESIiGIEhQRgSIiIkIiIiIQEiFEERESGIgRERGIEhERgSIiIiIiIiIQEhRBEhERIREYiIERIRERgSIiIhESIiIQEUQRIQohERIi4acREhGBIiIRiBEiIhAUQSESERERESIiIhESERgRIiIYEYgSEhAUGBIRESESEREREREhIRGBIiGIiIEiERAREYEhEREhIRESERESERIYEiIRGBIhgRARGBgSEREhISEhISERESGIESIiIRIYgRARgRGBIhESEREhIREREhiBERIiIhGBEhAYEUEYESERERESERESIYGBEhEiIRERIhARFBGBiBEYERERERIhGBGBIRESEiIREhARQRgUEYgRESIiIiEYgRGBIRERIhESEhAUEYERQhGIgRERERiBEUGBIREYEiEhEhARGBFBFCERGIiIiIEYEUGBEhGIESISEhARgRgUEUJBgRERERiIEUIYERiBERISEhAYERgRQSQhGBERGIEYEUIYgYgSEhEhIhASEhGBQUJCGBJBGIiIEUJBiIERERESIhARERGBQSQhGBJBGBEYEUEUGBESEhIRIhASEhIYEUJCGBJBGIiIERRBgRgREREREhAREREYFCQhGBERERERREhBgUGBEhISERASEhIRgUJCGBREREREiIQYESQYERERERAEAC8AJQAAAACA42neFRHjZxERERASIiIiIhQkRCRCRCRCRCQRIiIiIiIiIhASIiIiIiFCRCRCRCRCQkESIiIiQiIiIhASIiIiIiIUIiRCIiRCJBEiIiIkRCIiIhARIiIiIiIhRERERERERBIiIiJEREIiIhAREiIiIiIhERERERERERIiIilEREkiIhARgSIiIiIhERGBIiIiIhEiIpRERESSIhARgSIiIiIhEYGBIiIiIhEiIpRERESSIhARgSIiIiIhgYGBIREhERgSJEREREREIhARgSIiEiIhgYGBEhESERgSREREREREQhARgSIhEiIhgYGBIiISIhgSJEREREREIhARgSEYEiIhgYGBIiISIhgSIpRERESSIhARERiBIiIhgYGBIiISIhgSIpRERESSIhAUiIERIiIhgYGBIiERIhgSIilEREkiIhARgRESIiIhgYGBIiIiIhgREiJEREIiIhAUgRIiIiEYgYGBIiERISgYgSIkRCIiIhARgSIiIhiBgYGBEiIiIRiBgSIiQiIiIhAUgSIiIhgRgRgUISIiEkGIgSIiIiIiIRARgSIiIhiIGIFERBERREQRERIiIiIiFBAUgSIiIhERERFEREREREESGBESIiIhgRARgSIiEUERIRERREREQRERGBIREiIhhBAUgSIRGBQRESEREREREREhGBEYgRIhgRARgREREYFBEREhERERESERGBIYgUERhBAUgRERERgUERERISEhIRFBGBERgURBgRARgRFBERGBQREREREREUFBGIEhiBFBhBARESEUEREYFBFBQUFBQUFBIYERGIgRgRASISGBQRERgUEUhISEhISBIYgSERiBhBARESEYFBERGBQRQUFBQUFBIRiBEhERgRASIRGBgUEREYFBEUFBQUFBIRGIgREhhBAREUQYERgRERgUEUFBQUFBIRIRiIERgRASESQYGIFBERGBQRSEhISBIRISEYiBhBARgURBgRFIEREYFBFBQUFBIRIRgRERgRARgSJBgYFIQRERgUERQUFBIRIREYFBhBAUgURBgRFISBEhGBQRQUFBIRIYgYEhgRARgSJBgYFIQRERFIFBFISBERIRGBRBhBAUgURBgRFIESERhEgUEUFBERGIGBQhgRARgSJBgYFBEREUGESBQRQRIRERgURBhBAEAC8AJQAAAACA42neFRHjZxERERASIiIiIiIiIhgYiBiIGIgYiIiBIiIiIhASIkRJIilEQiERgRGBEYERgRgSIiIiIhASJEREkpRERCIYiIiIiIiBiBEiESIiIhASREREQkREREIhREREREiIiBIhiBIiIhASREREREREREIhERERERRERBIhiBESIhASREREREREREIhIiIiIhERERERgSIRIhASREREREREREIhIiIiIhISEhIhgSIYEhASlERERERERJIRERIRERISEhEYgREYEhASKURERERESSEhESERIRISEhEYgRIhIhASKURERERESSEhIiEiIhISEhIYgSIhIhASIpREREREQiEhIiEiIhISEhIhERERIhASIiREREREIiEhIiEiIhISEiEiFERBIhASIiJERERCIhISIhESIiEhISEhEREREhASIiIkREQiIhISIiIiIiEiEhIRQUFBQRASIiIiREIiIiESEhESIiISEhIUREREERASIiIiJCIhEREiEiIiISEhISIRRERBIhASIiIiIiERQRIhISIhISEhIiEiERQSRBASIiIiERERFBESISEhIREiIRISIhEUQRASIiIRFBIhFEEhEiEhIhIREiIiEUERERASIhEiFBIiEUQRIhEhEhiBIhIhQUGBERASERISFBISIRRBEYESEYiBISIUgUERgRARiEEhIUEhIhRBGBgRiIgSIiFIFBERGBAYREESIUEiIhFEEYEYiIgRIiGEFBgRERAUQRERIhQSEiFEQRGIiIgSIhhBQRSIERAUEREUEhRBISEUQRiIiIEiEhQUQREYgRARgRFEQSFEEiIURBiIiBEhIhFEERFEiBAYRIERRBIURBIRQYiIgUEiIRRBERRESBAUSIhBEREhFEESEYiIgRIhFEEREUSEGBAUiIFIgRESIREREREREREUQRERFEREiBAYiBQRGBEREiIiRERERERBERERRIQYgRAYiBSIiBgSIiQRERERERESEREURESIgRAYiBQRGBgSIiIiIhREQSIiERFEhBiIERAYiBSIiBgSIiIiERJEQSEhERSERIiBERARiIFIgRERERERIRERQRIREREUGIgRFBARGIiBERERESIhGIiIESIREUQYiIERQRAUEYEREYiIgSIhGBQYEiEhiIiIiBERRBAEAC8AJQAAAACA42neFRHjZxERERASIiIiIiIRISEiERSIiIEiIiIiIiIiIhASIiIiIiESEhISERSBiBIiREkiKURCIhASIiIiIhERIRIiERSIiBIkRESSlEREIhASIiIiIhgSEiEiIRSBgSJERERCREREQhASIiIiIRgRIiIRIRRIgSJEREREREREQhASIiIiIYQSIiIiERFIgSJEREREREREQhASIiIiEYQRESERIRFEiBJEREREREREQhASIiIiGEQREhESEREUSBKUREREREREkhASIiIhGEQSIhIiISERQSIpRERERERJIhASIiIhhEgSIhIiISEREiIpRERERERJIhASIiIhhEgSIhIiISIRESIiRERERESSIhASIiIhhEgSIREiIhIRERIiJEREREQiIhASIiIYRIgSIiIiIhIhEREiIkREREIiIhASIiIYRIERIREiIYEiERESIiRERCIiIhASIiIYRBGBIhIiGIEiIREREiJEQiIiIhASIiIYQYEYEiIhiBESIhERERIkIiIiIhASIiIYEoERgREYgRGBIiERERIiIiIiIhASIiIRghgRGIiBERgSEiIRESIiESESIhASIiEYGEKBEREREYQoERIiEiIhiBiBIhASIhiIgYIYgREYiBKBEREREiIhhEQSIhASIRGBGBhCGIiBJIgRESIiISIiGEiBIhASGIiIiIGIhCFIiBEhEiEhIRIREYgSEhARERgRGIERGIiBERgRISIiFEGIgRGBEhAYiIiIiBEiEREYERgRIiIRRBiIEiEYEhAREYERGBISERERgYESEhFEERERIiGIEhAYiIiIgRIRESIRgYESIURBiIEhERGBIhARgYERgREhEiEhGBEhIUQYREEhQSESIhAYiIiIgSEhQRIhGBEiFEGESEESESESIhARGBgRgREhhEEiGBISFEGERBESEhIhIhAYiIiIgRIRiEQSERIhRBhEhBEhEhIhIhARgREYESEYGIQRERIhRBhERBIREiERIhAYiIiIESEYEYQRiBERRBhIRBISEiIUEhARgRiBESEYQYhBEYiBFBhEERIREhFEQRAYiIgUERIYQYRBgREYgRERRBEhEURERBAREYFEEhIYEYhBgYiBGIFESBISFEREQRAYiBREESEYGIQYGERIERRIiBESFERBGBAEAC8AJQAAAACA42jeFRHiZxERERASIiIiIhRCREJCRCQkRCQSIiIiIiIiIhARIhESIiFEJEJCRCQkQkEiREkiKURCIhAUEiGBIiIUQiJCIiQiJBEkRESSlEREIhAUEiGIEiIUREREREREQRJERERCREREQhAUEiGIEiIRERERERERERJEREREREREQhARERIYgSIhgYGBgSIiISJEREREREREQhASQkIhgSIhgYGBgSIRISJEREREREREQhASQkIiESIYGBgYEhEhISKUREREREREkhASEhIhgSIYGBgYEiIiJiIpRERERERJIhARERIYgSIYGBgYEiIiIhIpRERERERJIhAUEiGIEiIYGBgYEiIiIiEiRERERESSIhAUEiGIEiIYGBgYEiIRJhEiJEREREQiIhAUEiGBIiIYGBgYEhESISIiIkREREIiIhAUEhESIhEYGBgYEiIiISIiIiRERCIiIhAUEiIiIYiBGBgYEiIhESIiIiJEQiISIhAUEiIiGIGBgYEYEiIiISIiIiIkIhFBEhAUEiIiGBiBgYGBREIiIREREiIiIhREEhAUEiIiGIEYgYEUREQRGIGIgSIiIiFBIhAUEiIiIYiIGBFEREREQYgRgSIiERFBIhAUEiIiIREREYgRREREQRiIgSIhIiFBIhAUEiIhFCQYiIiIERERiIGIESISIiIREhAUEiERERQhGIiIiIiIiIgRJBESIRISEhAUERIkQREUIRGIiIiIgREkRBERIhEREhAUFEIiJEERFCQRERERFCREERFEEiEiEhARERRCIiRBERQkJCQkJEQREUQiIREREhAYiBEUQiIkQQoRFBER4PtEIiJBESEiEBiBiIEUQiIkQRFBIiFBEUQiIkQRIhEiEBgYiBiBFEIiJEEUEhQRRCIiRBGBISESEBERgYhBERRCIiQRQUEUIiJEEYiBIiIREBIiGIQRiIEUQiJBFBFCIiQRiIiBISEREBEiIUEYiIiBRCIkERQiJEGIiIiBIiIREBIhIRGBEREREUIiQUIiQRERERGBISEREBEiIhiBIiIiIUQiERIkQSIiIiGBIiIREBESEhiBIRERIRRBIiFEESERESGBISEREBESIiGBIYgRESESERIRIREYgSGBIiIREBERISGBIYgRIhEhREEhEiEYgSGBISEREAQALwAlAAAAAIDjad4VEeNnEREREBIiIiIiIiIiGIiIiIiIiIiIiIEiIiIiEBIiIiIhIiIiIYiIiIGBgYGBgRIiIiIiEBIiIiIREiIiIhGBgYFBQUFBQSIiIiIiEBIiIiERESIiIkFBQUREREREEiIiIiIhEBIiIhERERIiIiFEREEREREREiIiIiIREBIiIREREREiIiEREREiIiIiESIiIiGBEBIiERERERESIiEhISEiIiIiEhIiIiGBEBIhERERERERIiEhISERESEREhIiIiGBEBIhERERERERIiEhISESERIRESIiIiGBEBIREREREREREiEhISEiIhIiEhIiIiGBEBIREREREREREiEhISEiIhIiEhIiIiGBEBIREREREREREiEhISEiIhIiEhIiIiGBEBIREREhIREREiEhISEiIREiEhIiIiGBEBIhERIhIhERIiEhISEhEiISEhIiIiGBEBIiIiIREiIiIREhISEhIREiESESIiGBEBIiIiERESIiEiEhISEiIiIiEhIhIiGBEBIiIiIiIiIhISEhISEiEiISEhIhIiGBEBIiIiIiIiERIRIhISESEhISEiEYESGBEBIiIiIiIRGBEiISISEiEhESIRGBEhGBEBIiIiIhGBSBEREhEhIhISGBQRgRIUGBEBIiIiERGBEYEYERERESEhGBEYESERGBEBIiIRgYEYEYFBGBgYERERgUGBEhREGBEBIhFEEREYFBgUQRERGBgRgRGBEhQRGBEBIUiBGBEYERgURIiIEREYFBgRIUREGBEBGEQRERgRgRgURIERiEQYERgRIUERGBEBSIQRgYGBgUGBRIiIiEQYEYESFEREGBEBRIEREYERgRGBERERERGBQYESFBEREREBhEEYGBiIGBGBEiISIhGBEYESFBiIgREBiEERGBgRGBGBIhIiEiGBGBEhQYERiIEBSIEYGBiIGBQYEhISEiGBGBEhQYgSGIEBRIERGBgRGBEYEiISIhgUGBERRBERIREBhEEYGBiIgYEYEhIiEhgRGBgRFEREEREBSEERGBgREYEYERERERgRgRERERERIiEBRIEYEYGIgYEYGIiIiIgRgRERERIiEREBEUEREYGBEYEYERERERgRgYgRGBEhIiEBIhIRgRgYgYFIERREERgRgRGIEREiEREAQALwAlAAAAAIDjWd4VEeMnEREREBIiIiIiIRIRISEkGBGIiBIiIiIiIiIiEBIhIiIiERESEhEkGIGIgSIiIiEiIiIiEBIhIiIiESEhEiEkGIiIgSIiIhESIiIiEBIhIiIiERISISIUGBGIEiIiIRERIiIiEBIYEiIiEhEiIhIUGIGIEiIiEREREiIiEBIYEiIhEhIiIiEUQYiIgSIhERERESIiEBIYEiIhQhERIREUQYEYgSIRERERERIiEBIYEiIhQhESERIURBgYEiEREREREREiEBGIgSIhQhIiEiISRBiBIiEREREREREiEBGBgSIhQhIiEiIhREGBIhERERERERESEBGIgSIUQhIiEiIhJEQRIhERERERERESEBIYEiIUIRIhESIiFEQRIhERERERERESEBIYEiIUIRIiIiIiEkRBIhERESEhERESEBERESISEREhESIhQSREEiEREiEiEREiEBGIgSFCEREiEiIUESREESIiIhESIiIiEBIREiFCERgSIiERgRJEQRIiIRERIiIiEBGIgSFCGBGBERgYGIEkRBEiIiIiIiIiEBGIgSERGIEYGBgRiBESIiESIiIiRCIiEBIREiERGIiBERGIgRERERQRIiJEEUQiEBIUEhESEYGIiIgYERIhFERBgiRBiBRCEBIYEYESEYgYGBiBEiERREIYESJEEUQhEBIYFIgRERiIiIgRIRFERCGBGBEiRCIUEBEYFEgRIRgYGIESERREIhgRGIgSEiGEEBEYFEgRERGIiBEhFERCIYFBEYiBEhEYEBEYFEiBEhGIgRIRREQkQYEREREYEREYEBEYEkSBESERgSEURCJEQYFEQRERIiIYEBEYEUSIERGIEhFEQkRBEYERERESIiIYEBEYEhRIERhEgRREJEEREYgUREEiIiIYEBEYESRIgRhEgURCQREiERgRERIhIhGEEBEYEhFEiBhEgUQkERIiIRGBRBIREREUEBEYESFESIGIFEIRFCIRIhEYEREYEREREBEYEhIURIgRFCERIhEREiERgUGIGBEYEBEYESEhRERERBESIiIiIiIRGBiIGIiBEBEYEhISERERCRETERERiIiBGBARGBEhIURERAlED0REQRERGIEQERgSEg4REhESCxESERiIgREQBAAvACUAAAAAgONM3hUR4dcREREQEiIRIiFBREFBRBQURBRBIiIiIiIiIiIQEiGIEiIUFEFBRBQUQUQSIiIiISIiIiIQEhgUgSIhQRFBERQRFEEiIiIiERIiIiIQEhgUgSIiFEREREREREEiIiIhEREiIiIQEhgUgSIiEREREREREREiIiIRERESIiIQEiGIEiIiEiIiGBgYGBIiIiERERERIiIQEiIRIiIiEhEiGBgYGBIiIhEREREREiIQEiGIEiIiEhIRIYGBgYEiIRERERERESIQEhgUgSIiYiIiIYGBgYEiIRERERERESIQEiGIEiIhIiIiIYGBgYEiERERERERERIQEiIRIiISIiIiIYGBgYEiERERERERERIQEiGIEiIRIhEmIYGBgYEiERERERERERIQEhgUgSIiEiEWIYGBgYEiERERISERERIQEhgUgSIiEiIiIYGBgYgRIRESISIRESIQEhgUgSIiERIiGIGBgYiIEiIiERIiIiIQEiGIEiIiEiIiGIGIGBgYgSIhEREiIiIQEhEREiIhEiIiQRgYGBiBgSIiIiIiIiIQEhIiESERFiJERBgRgYEYgSIiIiIiIiIQEiESIRERERRERBGIGBiIESIiIiIiIiIQEhIhERIREREJEeDrESIiIiIiIhASEhESEhEREREREREREREhIREiIiIiIhASERIRESGBgYGBgYGBgYEhESERIiIiIhARQREhISEREREREREREREhISEUESIiIhAUEUEhERIUREREREREREEhESFEQREiERARFBESEhIRSESESESESEEhISFBEUQRgRARQRgSEREhREgYSEgYREEhESERRBGIgRAUEYGBISEhFIGEiISBhEEhISFEEYgRERARGBgRIRERgUhEgYRIREEhESERGIiIERARgYGBEhGBERESERIREhEhISERiBERGBAYGBgRERgRgQkhKxERGIiIgRgQEYGBFBGBGIESERIREhERISERiBgREYEQGIgRJBgREYEJERMRGIiIiBGBEBgRFEGBGIiBCSITIhiBgREYFBARESQYEYERgQlEE0GIiIiBGEQQERRBgRiIiBEJESMRgYEREYFEEBGEGBERgRgRGBEhIiESESEYiIiIGEREEAQAJwAnAAAAAIDi8MMJIg8iISIiIiIiIiIiIiAJIg8iERIiIiIiIiIiIiAJIg8hEREiIiIiIiIiIiAJIuJ7EREREiIiIiIiIiIgIiIiIiIiIiEREhERIiIiIiIiIiAiIiIiIiIiEREhIRESIiIiIiIiICIiIiIiIiEREhESEREiIiIiIiIgIiIiIiIiEREhEREhERIiIiIiIiAiIiIiIiEREhERERIRESIiIiIiICIiIiIiEREhERIRESEREiIiIiIgIiIiIiEREhERISEREhERIiIiIiAiIiIiEREhERIREhERIRESIiIiICIiIiEREhERIRIRIRESEREiIiIgIiIiEREhERIRISESEREhERIiIiAiIiEREhERIRIREhEhERIRESIiICIiEREhERIREhESERIRESEREiIgIiEREhERIRERISERESEREhERIiAiEREhERESERESERESERERIRESICIREhEREREhESEhESERERESERIgIRESERIRERISERISERESERIRESAhESERESESESESESESESERESERICERIRERIRESEhESEhERIRERIREgERIRESIRESERISERIRESIRESERAREhESERESERESERESERESERIREBESERIRESEREREREREhERIREhEQERIREhESERESERIRERIREhESERAREhERIiERESEhISERESIhERIREBESERERERESERIREhEREREREhEQERIRERERESERERERIRERERESERARESERERESERERERESERERESERECERIhEREiEREhESEREiERESIREgIRERIiIhEREiERIhEREiIiERESAiEREREREREiIREiIRERERERESICIhEREREREiIRERIiERERERESIgIiIhERERIiIhEREiIiEREREiIiAJIg8RERESIiIiIiIiIiAJIjcRERESIiIiIiIiIiAiIiIiIiIiIREREREiIiIiIiIiICIiIiIiIiIRERERERIiIiIiIiIgAQALAAsAAAAAgB8LBw4AAAAOHwAAAAduwAAADv/gAAAHdcAAAAoOAAAAAQAJAAoAAAAAgB8KBxwAAAAKPgAAAAddAAAADv+AAAAHawAAAAocAAAAAQAPAA8AAAAAgDIPCwOAAAAHwAAADg/gAAAPB8AAADu4AAB//AAADv/+AAATfXwAADk4AAADgAAAB8AAAAEACwALAAAAAIAiCw8IAAAAHAAAAD4AAAAOfwAAAA8+AAAAHAAAAAgAAAAJAAEACQAKAAAAAIAkCg8IAAAAHAAAAD4AAAAOfwAAABM+AAAAHAAAAAgAAAAAAAAAAQAPAA8AAAAAgDoPEwEAAAADgAAAB8AAAA/gAAAKH/AAAA8/+AAAf/wAAD/4AAAKH/AAABMP4AAAB8AAAAOAAAABAAAAAQALAAsAAAAAgCYLBQALdwAAAPeAAAAO/4AAABd/AAAAPgAAABwAAAAIAAAAAAAAAAEACQAKAAAAAIAkCgt3AAAA94AAAA7/gAAAF38AAAA+AAAAHAAAAAgAAAAAAAAAAQAPAA8AAAAAgDEPDzx4AAB+/AAA/v4AABL//gAACn/8AAAbP/gAAB/wAAAP4AAAB8AAAAOAAAABAAAAAQALAAsAAAAAgCMLBQATCAAAABwAAAA+AAAAfwAAAA7/gAAAB2sAAAAKHAAAAAEACQAKAAAAAIAhChMIAAAAHAAAAD4AAAB/AAAADv+AAAAHawAAAAocAAAAAQAPAA8AAAAAgDUPGwEAAAADgAAAB8AAAA/gAAAf8AAAP/gAAAp//AAADv/+AAAT/X4AAHk8AAADgAAAB8AAAAEADAAMAAAAAIAmDAoCAAAACgcAAAAKDYAAABMYwAAAH8AAAD/gAAAwYAAACnjwAAABAAoADAAAAACALwwrHwAAAD+AAAAxgAAAAYAAAAOAAAAHAAAADgAAABwAAAA5gAAAMYAAAAo/gAAAAQAKAAwAAAAAgC0MCj+AAAAXMwAAAAYAAAAMAAAAHwAAAB+AAAAKAYAAAA8xgAAAP4AAAB8AAAABAAoADAAAAACAKQwbAwAAAAcAAAAPAAAAHwAAADsAAABzAAAACn/AAAAKAwAAAAoHgAAAAQAKAAwAAAAAgCcMCn8AAAAKYAAAAAt+AAAAfwAAAAoDAAAACmMAAAALfwAAAD4AAAABAAoADAAAAACAKAwbDwAAAB8AAAA4AAAAMAAAAD8AAAA/gAAAEjGAAAALP4AAAB8AAAABAAoADAAAAACAGgwKP4AAAAcxgAAACgMAAAAOBgAAABIMAAAAAQAKAAwAAAAAgCYMCx8AAAA/gAAADjGAAAALHwAAAD+AAAAOMYAAAAs/gAAAHwAAAAEACgAMAAAAAIAoDAsfAAAAP4AAABIxgAAAGz+AAAAfgAAAAYAAAAOAAAAfAAAAHgAAAAEACgAMAAAAAIAYDAtngAAAb8AAACJswAAAC2/AAABngAAAAQAKAAwAAAAAgBkMCg8AAAAaBgAAAApmAAAAC34AAAA8AAAAAQAKAA4AAAAAgCAOCz4AAAB/AAAAImMAAAATfwAAAD4AAAAHAAAAAwAAAAEACgAMAAAAAIAsDAr3gAAAI2YAAABsAAAAeAAAAHAAAAB4AAAAbAAAAGYAAABjAAAACveAAAA='!

Item was added:
+ ----- Method: PlayingCard class>>includeInNewMorphMenu (in category 'all') -----
+ includeInNewMorphMenu
+ 
+ 	^false!

Item was added:
+ ----- Method: PlayingCard class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"PlayingCard initialize"
+ 	"Read the stored forms from mime-encoded data in imageData."
+ 	| forms f |
+ 	f := Base64MimeConverter
+ 				mimeDecodeToBytes: (ReadStream on: self imageData).
+ 	forms := OrderedCollection new.
+ 	f next = 2
+ 		ifFalse: [self error: 'corrupted imageData' translated].
+ 	[f atEnd]
+ 		whileFalse: [forms
+ 				add: (Form new readFrom: f)].
+ 	"1/2 image of Kc, Qc, Jc, ... d, h, s, and center image of As"
+ 	FaceForms := forms copyFrom: 1 to: 13.
+ 	"Images of small club, smaller club (for face cards), large club (for 
+ 	2-10, A), 
+ 	followed by 3 more each for diamonds, heardt, spaces, all as 1-bit 
+ 	forms. "
+ 	SuitForms := forms copyFrom: 14 to: 25.
+ 	"Images of A, 2, 3 ... J, Q, K as 1-bit forms"
+ 	NumberForms := forms copyFrom: 26 to: 38.
+ 	CardSize := 71 @ 96.
+ 	FaceLoc := 12 @ 11.
+ 	NumberLoc := 2 @ 4.
+ 	SuitLoc := 3 @ 18.
+ 	FaceSuitLoc := 2 @ 18.
+ 	TopSpotLocs := {{}. {28 @ 10}. {28 @ 10}. {15 @ 10. 41 @ 10}. {15 @ 10. 41 @ 10}. {14 @ 10. 42 @ 10}. {14 @ 10. 42 @ 10}. {14 @ 10. 28 @ 26. 42 @ 10}. {14 @ 10. 14 @ 30. 42 @ 10. 42 @ 30}. {14 @ 10. 14 @ 30. 42 @ 10. 42 @ 30. 28 @ 21}}.
+ 	"A"
+ 	"2"
+ 	"3"
+ 	"4"
+ 	"5"
+ 	"6"
+ 	"7"
+ 	"8"
+ 	"9"
+ 	"10"
+ 	MidSpotLocs := {{28 @ 40}. {}. {28 @ 40}. {}. {28 @ 40}. {14 @ 40. 42 @ 40}. {14 @ 40. 42 @ 40. 28 @ 26}. {14 @ 40. 42 @ 40}. {28 @ 40}. {}}.
+ 	"A"
+ 	"2"
+ 	"3"
+ 	"4"
+ 	"5"
+ 	"6"
+ 	"7"
+ 	"8"
+ 	"9"
+ 	"10"
+ 	ASpadesLoc := 16 @ 27!

Item was added:
+ ----- Method: PlayingCard class>>test (in category 'all') -----
+ test    "Display all cards in the deck"
+ 	"MessageTally spyOn: [20 timesRepeat: [PlayingCard test]]"
+ 	1 to: 13 do: [:i | 1 to: 4 do: [:j |
+ 		(PlayingCard the: i of: (#(clubs diamonds hearts spades) at: j)) cardForm
+ 				displayAt: (i-1*CardSize x)@(j-1*CardSize y)]]!

Item was added:
+ ----- Method: PlayingCard class>>the:of: (in category 'all') -----
+ the: cardNo of: suitOrNumber
+ 
+ 	^ self new setCardNo: cardNo
+ 		suitNo: (suitOrNumber isNumber
+ 				ifTrue: [suitOrNumber]
+ 				ifFalse: [#(clubs diamonds hearts spades) indexOf: suitOrNumber])
+ 		cardForm: (Form extent: CardSize depth: Display depth)!

Item was added:
+ ----- Method: PlayingCard>>blankCard (in category 'all') -----
+ blankCard 
+ 
+ 	CachedDepth = Display depth ifFalse:
+ 		[CachedDepth _ Display depth.
+ 		CachedBlank _ Form extent: CardSize depth: CachedDepth.
+ 		CachedBlank fillWhite; border: CachedBlank boundingBox width: 1.
+ 		CachedBlank fill: (0 at 0 extent: 2 at 2) fillColor: Color transparent.  "Round the top corners"
+ 		CachedBlank fill: (1 at 1 extent: 1 at 1) fillColor: Color black.
+ 		CachedBlank fill: (CachedBlank width-2 at 0 extent: 2 at 2) fillColor: Color transparent.
+ 		CachedBlank fill: (CachedBlank width-2 at 1 extent: 1 at 1) fillColor: Color black].
+ 	^ CachedBlank!

Item was added:
+ ----- Method: PlayingCard>>buildImage (in category 'all') -----
+ buildImage     "(PlayingCard the: 12 of: #hearts) cardForm display"
+ 	"World addMorph: (ImageMorph new image: (PlayingCard the: 12 of: #hearts) cardForm)"
+ 	"PlayingCard test"
+ 	| blt numForm suitForm spot face ace sloc colorMap fillColor |
+ 	
+ 	"Set up blt to copy in color for 1-bit forms"
+ 	blt _ BitBlt current toForm: cardForm.
+ 	fillColor _ self color.
+ 	colorMap _ (((Array with: Color white with: fillColor)
+ 				collect: [:c | cardForm pixelWordFor: c])
+ 					 as: Bitmap).
+ 
+ 	blt copy: cardForm boundingBox from: 0 at 0 in: self blankCard.  "Start with a blank card image"
+ 	numForm _ NumberForms at: cardNo.  "Put number in topLeft"
+ 	blt copyForm: numForm to: NumberLoc rule: Form over colorMap: colorMap.
+ 
+ 	suitForm _ SuitForms at: suitNo*3-2.   "Put small suit just below number"
+ 	sloc _ SuitLoc.
+ 	cardNo > 10 ifTrue:
+ 		[suitForm _ SuitForms at: suitNo*3-1.   "Smaller for face cards"
+ 		sloc _ SuitLoc - (1 at 0)].
+ 	blt copyForm: suitForm to: sloc rule: Form over colorMap: colorMap.
+ 
+ 	cardNo <= 10
+ 	ifTrue:
+ 		["Copy top-half spots to the number cards"
+ 		spot _ SuitForms at: suitNo*3.   "Large suit spots"
+ 		(TopSpotLocs at: cardNo) do:
+ 			[:loc | blt copyForm: spot to: loc rule: Form over colorMap: colorMap]]
+ 	ifFalse:
+ 		["Copy top half of face cards"
+ 		face _ FaceForms at: suitNo-1*3 + 14-cardNo.
+ 		blt colorMap: self faceColorMap;
+ 			copy: (FaceLoc extent: face extent) from: 0 at 0 in: face].
+ 
+ 	"Now copy top half to bottom"
+ 	self copyTopToBottomHalf.
+ 
+ 	cardNo <= 10 ifTrue:
+ 		["Copy middle spots to the number cards"
+ 		(MidSpotLocs at: cardNo) do:
+ 			[:loc | blt copyForm: spot to: loc rule: Form over colorMap: colorMap]].
+ 	(cardNo = 1 and: [suitNo = 4]) ifTrue:
+ 		["Special treatment for the ace of spades"
+ 		ace _ FaceForms at: 13.
+ 		blt colorMap: self faceColorMap;
+ 			copy: (ASpadesLoc extent: ace extent) from: 0 at 0 in: ace]
+ 	!

Item was added:
+ ----- Method: PlayingCard>>cardForm (in category 'all') -----
+ cardForm
+ 
+ 	^ cardForm!

Item was added:
+ ----- Method: PlayingCard>>color (in category 'all') -----
+ color
+ 	CachedDepth = 1 ifTrue: [^ Color black].
+ 	CachedDepth = 2 ifTrue: [^ Color perform: (#(black gray gray black) at: suitNo)].
+ 	^ Color perform: (#(black red red black) at: suitNo)!

Item was added:
+ ----- Method: PlayingCard>>copyTopToBottomHalf (in category 'all') -----
+ copyTopToBottomHalf
+ 	"The bottom half is a 180-degree rotation of the top half (except for 7)"
+ 	| topHalf corners |
+ 	topHalf _ 0 at 0 corner: cardForm width@(cardForm height+1//2).
+ 	corners _ topHalf corners.
+ 	(WarpBlt current toForm: cardForm)
+ 		sourceForm: cardForm;
+ 		combinationRule: 3;
+ 		copyQuad: ((3 to: 6) collect: [:i | corners atWrap: i])
+ 		toRect: (CardSize - topHalf extent corner: CardSize).
+ 	!

Item was added:
+ ----- Method: PlayingCard>>faceColorMap (in category 'all') -----
+ faceColorMap
+ 	| map |
+ 	map _ Color colorMapIfNeededFrom: 4 to: Display depth.
+ 	^ map!

Item was added:
+ ----- Method: PlayingCard>>setCardNo:suitNo:cardForm: (in category 'all') -----
+ setCardNo: c suitNo: s cardForm: f
+ 	cardNo _ c.
+ 	suitNo _ s.
+ 	cardForm _ f.
+ 	self buildImage!

Item was added:
+ AlignmentMorph subclass: #PlayingCardDeck
+ 	instanceVariableNames: 'layout stackingPolicy stackingOrder emptyDropPolicy target acceptCardSelector cardDroppedSelector cardDoubleClickSelector cardDraggedSelector seed'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!

Item was added:
+ ----- Method: PlayingCardDeck class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 
+ 	^false!

Item was added:
+ ----- Method: PlayingCardDeck class>>newDeck (in category 'instance creation') -----
+ newDeck
+ 	^self new newDeck!

Item was added:
+ ----- Method: PlayingCardDeck class>>newSuit: (in category 'instance creation') -----
+ newSuit: suit
+ 	^self new newSuit: suit!

Item was added:
+ ----- Method: PlayingCardDeck class>>suits (in category 'symbols') -----
+ suits
+ 
+ 	^{#Clubs. #Diamonds. #Hearts. #Spades}!

Item was added:
+ ----- Method: PlayingCardDeck class>>values (in category 'symbols') -----
+ values
+ 
+ 	^#(Ace),((2 to: 9) collect: [:i | i printString asSymbol]), #(Jack Queen King)!

Item was added:
+ ----- Method: PlayingCardDeck>>acceptCard:default: (in category 'dropping/grabbing') -----
+ acceptCard: aCard default: aBoolean 
+ 	"if target and acceptCardSelector are both not nil, send to target, if not  
+ 	nil answer  
+ 	else answer aBoolean"
+ 	"Rewrote this a little (SmallLint calls this 'intention revealing')-th"
+ 	^ (target isNil or: [acceptCardSelector isNil])
+ 		ifTrue: [aBoolean]
+ 		ifFalse: [(target
+ 				perform: acceptCardSelector
+ 				with: aCard
+ 				with: self)
+ 				ifNil: [aBoolean]]!

Item was added:
+ ----- Method: PlayingCardDeck>>acceptCardSelector: (in category 'accessing') -----
+ acceptCardSelector: aSymbolOrString
+ 
+ 	acceptCardSelector _ self nilOrSymbol: aSymbolOrString.!

Item was added:
+ ----- Method: PlayingCardDeck>>acceptDroppingMorph:event: (in category 'layout') -----
+ acceptDroppingMorph: aMorph event: evt 
+ 	target
+ 		rememberUndoableAction: [target inAutoMove
+ 				ifFalse: [target removeProperty: #stateBeforeGrab].
+ 			self addMorph: aMorph.
+ 			aMorph hasSubmorphs
+ 				ifTrue: ["Just dropped a sub-deck of cards"
+ 					aMorph submorphs
+ 						reverseDo: [:m | self addMorphFront: m]].
+ 			(target notNil
+ 					and: [cardDroppedSelector notNil])
+ 				ifTrue: [target perform: cardDroppedSelector]]
+ 		named: 'move card' translated!

Item was added:
+ ----- Method: PlayingCardDeck>>addCard: (in category 'accessing') -----
+ addCard: aPlayingCard
+ 	self addMorph: aPlayingCard!

Item was added:
+ ----- Method: PlayingCardDeck>>cardDoubleClickSelector: (in category 'accessing') -----
+ cardDoubleClickSelector: aSymbolOrString
+ 
+ 	cardDoubleClickSelector _ self nilOrSymbol: aSymbolOrString.!

Item was added:
+ ----- Method: PlayingCardDeck>>cardDraggedSelector: (in category 'accessing') -----
+ cardDraggedSelector: aSymbolOrString
+ 
+ 	cardDraggedSelector _ self nilOrSymbol: aSymbolOrString.!

Item was added:
+ ----- Method: PlayingCardDeck>>cardDroppedSelector: (in category 'accessing') -----
+ cardDroppedSelector: aSymbolOrString
+ 
+ 	cardDroppedSelector _ self nilOrSymbol: aSymbolOrString.!

Item was added:
+ ----- Method: PlayingCardDeck>>cards (in category 'accessing') -----
+ cards
+ 
+ 	^submorphs!

Item was added:
+ ----- Method: PlayingCardDeck>>deal (in category 'shuffling/dealing') -----
+ deal
+ 	| card |
+ 	^ self cards notEmpty 
+ 		ifTrue: 
+ 			[card := self topCard.
+ 			card delete.
+ 			card]
+ 		ifFalse: [nil]!

Item was added:
+ ----- Method: PlayingCardDeck>>deal: (in category 'shuffling/dealing') -----
+ deal: anInteger
+ 
+ 	^(1 to: anInteger) collect: [:i | self deal]!

Item was added:
+ ----- Method: PlayingCardDeck>>doubleClickOnCard: (in category 'events') -----
+ doubleClickOnCard: aCard 
+ 	(target notNil and: [cardDoubleClickSelector notNil]) 
+ 		ifTrue: 
+ 			[^target 
+ 				perform: cardDoubleClickSelector
+ 				with: self
+ 				with: aCard]!

Item was added:
+ ----- Method: PlayingCardDeck>>emptyDropNotOk: (in category 'dropping/grabbing') -----
+ emptyDropNotOk: aPlayingCard
+ 
+ 	^(self emptyDropOk: aPlayingCard) not!

Item was added:
+ ----- Method: PlayingCardDeck>>emptyDropOk: (in category 'dropping/grabbing') -----
+ emptyDropOk: aPlayingCard
+ 
+ 	emptyDropPolicy = #any 			ifTrue: [^true].
+ 	emptyDropPolicy = #inOrder			ifTrue: [^self inStackingOrder: aPlayingCard].
+ 	emptyDropPolicy = #anyClub 		ifTrue: [^aPlayingCard suit = #club].
+ 	emptyDropPolicy = #anyDiamond		ifTrue: [^aPlayingCard suit = #diamond].
+ 	emptyDropPolicy = #anyHeart		ifTrue: [^aPlayingCard suit = #heart].
+ 	emptyDropPolicy = #anySpade		ifTrue: [^aPlayingCard suit = #spade].!

Item was added:
+ ----- Method: PlayingCardDeck>>emptyDropPolicy: (in category 'accessing') -----
+ emptyDropPolicy: aSymbol
+ 	"#any #inOrder #anyClub #anyDiamond #anyHeart #anySpade"
+ 
+ 	emptyDropPolicy _ aSymbol!

Item was added:
+ ----- Method: PlayingCardDeck>>hasCards (in category 'accessing') -----
+ hasCards
+ 
+ 	^self hasSubmorphs!

Item was added:
+ ----- Method: PlayingCardDeck>>ifEmpty: (in category 'dropping/grabbing') -----
+ ifEmpty: aBlock
+ 
+ 	self hasSubmorphs not ifTrue: [^aBlock value]!

Item was added:
+ ----- Method: PlayingCardDeck>>ifEmpty:ifNotEmpty: (in category 'dropping/grabbing') -----
+ ifEmpty: aBlock1 ifNotEmpty: aBlock2
+ 
+ 	self hasSubmorphs not 
+ 		ifTrue: [^aBlock1 value]
+ 		ifFalse: [^aBlock2 value]!

Item was added:
+ ----- Method: PlayingCardDeck>>inStackingOrder: (in category 'dropping/grabbing') -----
+ inStackingOrder: aPlayingCard
+ 
+ 	^self inStackingOrder: aPlayingCard event: nil!

Item was added:
+ ----- Method: PlayingCardDeck>>inStackingOrder:event: (in category 'dropping/grabbing') -----
+ inStackingOrder: aCard event: evt
+ 
+ 	self hasSubmorphs 
+ 		ifTrue: [^ self inStackingOrder: aCard onTopOf: self topCard]
+ 		ifFalse: [stackingOrder = #ascending ifTrue: [^ aCard cardNumber = 1].
+ 				stackingOrder = #descending ifTrue: [^ aCard cardNumber = 13]].
+ 	^ false.!

Item was added:
+ ----- Method: PlayingCardDeck>>inStackingOrder:onTopOf: (in category 'dropping/grabbing') -----
+ inStackingOrder: aCard onTopOf: cardBelow
+ 	| diff |
+ 	(stackingPolicy = #altStraight and: [aCard suitColor = cardBelow suitColor]) ifTrue: [^ false].
+ 	(stackingPolicy = #straight and: [aCard suit ~= cardBelow suit]) ifTrue: [^ false].
+ 	diff _ aCard cardNumber - cardBelow cardNumber.
+ 	stackingOrder = #ascending 	ifTrue: [^ diff = 1].
+ 	stackingOrder = #descending	ifTrue: [^ diff = -1].
+ 	^ false.!

Item was added:
+ ----- Method: PlayingCardDeck>>initialize (in category 'initialization') -----
+ initialize
+ 	super initialize.
+ 	self cellPositioning: #topLeft.
+ 	self reverseTableCells: true.
+ 	self layout: #grid.
+ 	self hResizing: #shrinkWrap.
+ 	self vResizing: #shrinkWrap.
+ 	borderWidth _ 0.
+ 	self layoutInset: 0.
+ 	stackingPolicy _ #stagger.
+ 	stackingOrder _ #ascending.
+ 	emptyDropPolicy _ #any.
+ 	self newSeed.
+ 	^self!

Item was added:
+ ----- Method: PlayingCardDeck>>insertionIndexFor: (in category 'dropping/grabbing') -----
+ insertionIndexFor: aMorph
+ 	"Return the index at which the given morph should be inserted into the submorphs of the receiver."
+ 
+ 	^1!

Item was added:
+ ----- Method: PlayingCardDeck>>layout: (in category 'accessing') -----
+ layout: aSymbol
+ 	" #grid #pile #stagger"
+ 	layout _ aSymbol.
+ 	layout == #grid 
+ 		ifTrue:[self maxCellSize: SmallInteger maxVal].
+ 	layout == #pile 
+ 		ifTrue:[self maxCellSize: 0].
+ 	layout == #stagger 
+ 		ifTrue:[self maxCellSize: self staggerOffset].!

Item was added:
+ ----- Method: PlayingCardDeck>>newDeck (in category 'initialization') -----
+ newDeck
+ 	| cards |
+ 	cards := OrderedCollection new: 52.
+ 	PlayingCardMorph suits 
+ 		do: [:suit | 1 to: 13
+ 			do: [:cardNo | cards add: (PlayingCardMorph the: cardNo of: suit)]].
+ 	self addAllMorphs: cards.
+ 	^self!

Item was added:
+ ----- Method: PlayingCardDeck>>newSeed (in category 'accessing') -----
+ newSeed
+ 	seed _ (1 to: 32000) atRandom!

Item was added:
+ ----- Method: PlayingCardDeck>>newSuit: (in category 'initialization') -----
+ newSuit: suit
+ 	| cards |
+ 	cards := OrderedCollection new: 13.
+ 	1 to: 13 do: [:cardNo | cards add: (PlayingCardMorph the: cardNo of: suit)].
+ 	self addAllMorphs: cards.
+ 	^self!

Item was added:
+ ----- Method: PlayingCardDeck>>nilOrSymbol: (in category 'private') -----
+ nilOrSymbol: aSymbolOrString
+ 
+ 	(nil = aSymbolOrString or:
+ 	 ['nil' = aSymbolOrString or:
+ 	 [aSymbolOrString isEmpty]])
+ 		ifTrue: [^nil]
+ 		ifFalse: [^aSymbolOrString asSymbol]!

Item was added:
+ ----- Method: PlayingCardDeck>>printOn: (in category 'printing') -----
+ printOn: aStream 
+ 	| cards |
+ 	cards := self cards.
+ 	aStream nextPutAll: 'aCardDeck('.
+ 	cards size > 1 
+ 		ifTrue: 
+ 			[cards allButLast do: 
+ 					[:card | 
+ 					aStream
+ 						print: card;
+ 						nextPutAll: ', ']].
+ 	cards notEmpty ifTrue: [aStream print: cards last].
+ 	aStream nextPut: $)!

Item was added:
+ ----- Method: PlayingCardDeck>>removeAllCards (in category 'accessing') -----
+ removeAllCards
+ 	self removeAllMorphs!

Item was added:
+ ----- Method: PlayingCardDeck>>repelCard: (in category 'dropping/grabbing') -----
+ repelCard: aCard 
+ 	stackingPolicy = #none ifTrue: [^ self repelCard: aCard default: true].
+ 	stackingPolicy = #single ifTrue: [^ self ifEmpty: [self repelCard: aCard default: false]
+ 			ifNotEmpty: [true]].
+ 	(stackingPolicy = #altStraight or: [stackingPolicy = #straight])
+ 		ifTrue: [self ifEmpty: [^ self repelCard: aCard default: (self emptyDropNotOk: aCard)]
+ 				ifNotEmpty: [(self inStackingOrder: aCard onTopOf: self topCard)
+ 						ifFalse: [^ self repelCard: aCard default: true]]].
+ 	^ false!

Item was added:
+ ----- Method: PlayingCardDeck>>repelCard:default: (in category 'dropping/grabbing') -----
+ repelCard: aCard default: aBoolean
+ 	
+ 	^(self acceptCard: aCard default: aBoolean not) not!

Item was added:
+ ----- Method: PlayingCardDeck>>repelsMorph:event: (in category 'dropping/grabbing') -----
+ repelsMorph: aMorph event: evt
+ 
+ 	(aMorph isKindOf: PlayingCardMorph) 
+ 		ifTrue: [^self repelCard: aMorph]
+ 		ifFalse: [^true]!

Item was added:
+ ----- Method: PlayingCardDeck>>reverse (in category 'shuffling/dealing') -----
+ reverse
+ 	self invalidRect: self fullBounds.
+ 	submorphs _ submorphs reversed.
+ 	self layoutChanged.!

Item was added:
+ ----- Method: PlayingCardDeck>>rootForGrabOf: (in category 'dropping/grabbing') -----
+ rootForGrabOf: aCard 
+ 	self hasSubmorphs ifFalse: [^nil].
+ 	(target notNil and: [cardDraggedSelector notNil]) 
+ 		ifTrue: 
+ 			[^target 
+ 				perform: cardDraggedSelector
+ 				with: aCard
+ 				with: self]
+ 		ifFalse: [^self firstSubmorph]!

Item was added:
+ ----- Method: PlayingCardDeck>>seed (in category 'accessing') -----
+ seed
+ 	
+ 	^seed!

Item was added:
+ ----- Method: PlayingCardDeck>>seed: (in category 'accessing') -----
+ seed: anInteger
+ 	
+ 	seed _ anInteger!

Item was added:
+ ----- Method: PlayingCardDeck>>shuffle (in category 'shuffling/dealing') -----
+ shuffle
+ 	self invalidRect: self fullBounds.
+ 	submorphs _ submorphs shuffledBy: (Random new seed: seed).
+ 	self layoutChanged.!

Item was added:
+ ----- Method: PlayingCardDeck>>stackingOrder: (in category 'accessing') -----
+ stackingOrder: aSymbol
+ 	"#ascending #descending"
+ 
+ 	stackingOrder _ aSymbol!

Item was added:
+ ----- Method: PlayingCardDeck>>stackingPolicy (in category 'accessing') -----
+ stackingPolicy
+ 
+ 	^ stackingPolicy!

Item was added:
+ ----- Method: PlayingCardDeck>>stackingPolicy: (in category 'accessing') -----
+ stackingPolicy: aSymbol
+ 	"#straight #altStraight #single #none"
+ 
+ 	stackingPolicy _ aSymbol!

Item was added:
+ ----- Method: PlayingCardDeck>>staggerOffset (in category 'layout') -----
+ staggerOffset
+ 	^18!

Item was added:
+ ----- Method: PlayingCardDeck>>subDeckStartingAt: (in category 'accessing') -----
+ subDeckStartingAt: aCard
+ 	| i subDeck |
+ 
+ 	i _ submorphs indexOf: aCard ifAbsent: [^ aCard].
+ 	i = 1 ifTrue: [^aCard].
+ 	subDeck _ PlayingCardDeck new.
+ 	(submorphs copyFrom: 1 to: i-1) do:
+ 			[:m | m class = aCard class ifTrue: [subDeck addMorphBack: m]].
+ 	^subDeck.
+ 	!

Item was added:
+ ----- Method: PlayingCardDeck>>target: (in category 'accessing') -----
+ target: anObject
+ 
+ 	target _ anObject!

Item was added:
+ ----- Method: PlayingCardDeck>>topCard (in category 'accessing') -----
+ topCard
+ 
+ 	^self firstSubmorph!

Item was added:
+ ImageMorph subclass: #PlayingCardMorph
+ 	instanceVariableNames: 'cardNumber suitNumber'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!
+ 
+ !PlayingCardMorph commentStamp: '<historical>' prior: 0!
+ This class displays images from the PlayingCard class as morphs.  It attempts to be space-efficient by only producing its images on demand.!

Item was added:
+ ----- Method: PlayingCardMorph class>>cardSize (in category 'access') -----
+ cardSize
+ 	" a real hack, but I don't want to muck with Dan's class "
+ 	^71 at 96.!

Item was added:
+ ----- Method: PlayingCardMorph class>>height (in category 'access') -----
+ height
+ 	^self cardSize y!

Item was added:
+ ----- Method: PlayingCardMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 
+ 	^false!

Item was added:
+ ----- Method: PlayingCardMorph class>>suits (in category 'access') -----
+ suits
+ 	^ #(clubs diamonds hearts spades)!

Item was added:
+ ----- Method: PlayingCardMorph class>>test (in category 'testing') -----
+ test    "Display all cards in the deck"
+ 	"MessageTally spyOn: [20 timesRepeat: [PlayingCardMorph test]]"
+ 	| table row |
+ 	table _ AlignmentMorph newColumn.
+ 	self suits do: [:suit | 
+ 		row _ AlignmentMorph newRow.
+ 		table addMorph: row.
+ 		1 to: 13 do: [:cn |
+ 			row addMorph: 
+ 			(PlayingCardMorph the: cn of: suit)]].
+ 	table openInWorld.!

Item was added:
+ ----- Method: PlayingCardMorph class>>the:of: (in category 'initialize-release') -----
+ the: cardNumber of: suit
+ 
+ 	^ self new 
+ 		image: (PlayingCard the: cardNumber of: suit) cardForm;
+ 		cardNumber: cardNumber suitNumber: (self suits indexOf: suit)!

Item was added:
+ ----- Method: PlayingCardMorph class>>width (in category 'access') -----
+ width
+ 	^self cardSize x!

Item was added:
+ ----- Method: PlayingCardMorph>>aboutToBeGrabbedBy: (in category 'dropping/grabbing') -----
+ aboutToBeGrabbedBy: aHand
+ 	"I'm about to be grabbed by the hand.  If other cards are above me in a deck,
+ 	then move them from the deck to being submorphs of me"
+ 	| i |
+ 	super aboutToBeGrabbedBy: aHand.
+ 	self removeProperty: #undoGrabCommand.  "So it won't interfere with overall move"
+ 	self board captureStateBeforeGrab.
+ 	i _ owner submorphs indexOf: self ifAbsent: [^ self].
+ 	i = 1 ifTrue: [^ self].
+ 	(owner submorphs copyFrom: 1 to: i-1) do:
+ 		[:m | m class = self class ifTrue: [self addMorphBack: m]].
+ !

Item was added:
+ ----- Method: PlayingCardMorph>>board (in category 'access') -----
+ board
+ 
+ 	^ owner owner owner!

Item was added:
+ ----- Method: PlayingCardMorph>>cardDeck (in category 'access') -----
+ cardDeck
+ 
+ 	^self owner!

Item was added:
+ ----- Method: PlayingCardMorph>>cardNumber (in category 'access') -----
+ cardNumber
+ 	^cardNumber!

Item was added:
+ ----- Method: PlayingCardMorph>>cardNumber:suitNumber: (in category 'access') -----
+ cardNumber: c suitNumber: s
+ 	cardNumber _ c.
+ 	suitNumber _ s.!

Item was added:
+ ----- Method: PlayingCardMorph>>click: (in category 'event handling') -----
+ click: evt
+ 	
+ 	"since we really want to know about double-clicks before making our move, ignore this and wait until #firstClickTimedOut: arrives"!

Item was added:
+ ----- Method: PlayingCardMorph>>doubleClick: (in category 'event handling') -----
+ doubleClick: evt
+ 
+ 	^self cardDeck doubleClickOnCard: self!

Item was added:
+ ----- Method: PlayingCardMorph>>firstClickTimedOut: (in category 'event handling') -----
+ firstClickTimedOut: evt 
+ 	| root popUp |
+ 	root := owner rootForGrabOf: self.
+ 	root isNil 
+ 		ifTrue: 
+ 			["Display hidden card in front"
+ 
+ 			popUp := self copy.
+ 			self board owner owner addMorphFront: popUp.
+ 			self world displayWorld.
+ 			(Delay forMilliseconds: 750) wait.
+ 			popUp delete]
+ 		ifFalse: [evt hand grabMorph: root]!

Item was added:
+ ----- Method: PlayingCardMorph>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: evt
+ 
+ 	^ true!

Item was added:
+ ----- Method: PlayingCardMorph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
+ justDroppedInto: newOwner event: evt
+ 
+ 	(newOwner isKindOf: PlayingCardDeck)
+ 		ifFalse: ["Can't drop a card anywhere but on a deck"
+ 				self rejectDropMorphEvent: evt].
+ 	^super justDroppedInto: newOwner event: evt!

Item was added:
+ ----- Method: PlayingCardMorph>>mouseDown: (in category 'event handling') -----
+ mouseDown: evt
+ 	"Do nothing upon mouse-down except inform the hand to watch for a double-click; wait until an ensuing click:, doubleClick:, or drag: message gets dispatched"
+ 
+ 	evt hand waitForClicksOrDrag: self event: evt selectors: { #click:. #doubleClick:. #firstClickTimedOut:. nil} threshold: 5!

Item was added:
+ ----- Method: PlayingCardMorph>>printOn: (in category 'printing') -----
+ printOn: aStream
+ 
+ 	aStream
+ 		print: cardNumber;
+ 		nextPutAll: ' of ';
+ 		print: (self class suits at: suitNumber).!

Item was added:
+ ----- Method: PlayingCardMorph>>slideBackToFormerSituation: (in category 'dropping/grabbing') -----
+ slideBackToFormerSituation: evt
+ 
+ 	super slideBackToFormerSituation: evt.
+ 	self board removeProperty: #stateBeforeGrab.
+ 	self hasSubmorphs ifTrue:
+ 		["Just cancelled a drop of multiple cards -- have to unload submorphs"
+ 		self submorphs reverseDo: [:m | owner addMorphFront: m]].
+ !

Item was added:
+ ----- Method: PlayingCardMorph>>suit (in category 'access') -----
+ suit
+ 	^self class suits at: suitNumber!

Item was added:
+ ----- Method: PlayingCardMorph>>suitColor (in category 'access') -----
+ suitColor
+ 	^#(black red red black) at: suitNumber!

Item was added:
+ ----- Method: PlayingCardMorph>>suitNumber (in category 'access') -----
+ suitNumber
+ 
+ 	^suitNumber!

Item was added:
+ Morph subclass: #PluggableTabBarMorph
+ 	instanceVariableNames: 'target tabs activeTab'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Widgets'!
+ 
+ !PluggableTabBarMorph commentStamp: 'KLC 9/17/2004 11:26' prior: 0!
+ This morph manages a set of PluggableTabButtonMorphs.  Each tab should be added in the left to right order that they should be displayed.  Each tab will be evenly sized to fit the available space.  This morph intercepts mouse clicks, figures out which tab was clicked, pops up the new tab as the active tab and triggers the registered event.  See PluggableTabButtonMorph for information on what a tab can consist of.
+ 
+ Example:
+ 
+ (PluggableTabBarMorph on: nil)
+ 	addTab: (Text fromString: 'Test') withAction: [Transcript show: 'Test'; cr];
+ 	addTab: (Text fromString: 'Another') withAction: [Transcript show: 'Another'; cr];
+ 	width: 200;
+ 	openInHand
+ !

Item was added:
+ ----- Method: PluggableTabBarMorph class>>on: (in category 'instance creation') -----
+ on: anObject
+ 	^ super new target: anObject!

Item was added:
+ ----- Method: PluggableTabBarMorph>>activeTab (in category 'private - access') -----
+ activeTab
+ 	activeTab ifNil: [
+ 		self tabs size > 0 ifTrue: [
+ 			activeTab _ self tabs first key.
+ 			activeTab active: true]].
+ 	^ activeTab !

Item was added:
+ ----- Method: PluggableTabBarMorph>>activeTab: (in category 'private - access') -----
+ activeTab: aTabMorph
+ 	self activeTab ifNotNil: [self activeTab toggle].
+ 	activeTab _ aTabMorph.
+ 	self activeTab toggle.
+ 	aTabMorph delete.
+ 	self addMorphFront: aTabMorph.
+ 	self performActiveTabAction.
+ 	self changed.
+ !

Item was added:
+ ----- Method: PluggableTabBarMorph>>addTab:withAction: (in category 'access') -----
+ addTab: aStringOrTextOrMorph withAction: aSymbolOrBlock
+ 	"Add a new tab.  The tab will be added onto the end of the list and displayed on the far right of previously added tabs.  The first argument can be a simple String, a Text, or any Morph.  The second argument is the action to be performed when the tab is selected. It can either be a symbol for a unary method on the target object or a block.  Each tab is stored as an Association with the created tab as the key and the selector as the value."
+ 	| tabMorph |
+ 	tabMorph _ PluggableTabButtonMorph on: nil label: [ aStringOrTextOrMorph].
+ 	tabMorph color: self color.
+ 	self addMorphBack: tabMorph.
+ 	self tabs ifEmpty: [ self activeTab: tabMorph ].
+ 	self tabs add: (Association key: tabMorph value: aSymbolOrBlock).
+ 	self layoutChanged.
+ 	self changed.!

Item was added:
+ ----- Method: PluggableTabBarMorph>>color: (in category 'access') -----
+ color: aFillStyle
+ 	color _ aFillStyle.
+ 	self tabs do: [ :anAssociation |
+ 		anAssociation key color: aFillStyle ]
+ !

Item was added:
+ ----- Method: PluggableTabBarMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 	self tabs size > 0 ifFalse: [^ self ].
+ 	self tabs do: [ :anAssociation | | tab |
+ 		tab _ anAssociation key.
+ 		tab drawOn: aCanvas]!

Item was added:
+ ----- Method: PluggableTabBarMorph>>handlesMouseDown: (in category 'actions') -----
+ handlesMouseDown: anEvent
+ 	^ true!

Item was added:
+ ----- Method: PluggableTabBarMorph>>layoutChanged (in category 'actions') -----
+ layoutChanged
+ 	"Fix up our tabs bounds"
+ 	| tabsCount |
+ 	super layoutChanged.
+ 	tabsCount _ self tabs size.
+ 	tabsCount isZero ifFalse: [ | tabInnerExtent count |
+ 		tabInnerExtent _ ((self width -
+ 				((self tabs first key outerGap + self tabs last key outerGap) // 2)
+ 					- tabsCount)
+ 			 		// tabsCount)
+ 			@ (self height).
+ 		count _ 1.
+ 		self tabs do: [ :anAssociation | | tab |
+ 			tab _ anAssociation key.
+ 			tab innerExtent: tabInnerExtent.
+ 			count = 1
+ 				ifTrue: [tab position: self position]
+ 				ifFalse: [
+ 					tab position:
+ 						(self position translateBy:
+ 							((tabInnerExtent x + 1) * (count - 1))@0)].
+ 			count _ count + 1  ]	].
+ 	self changed.!

Item was added:
+ ----- Method: PluggableTabBarMorph>>mouseDown: (in category 'actions') -----
+ mouseDown: anEvent
+ 	| xPosition newTab |
+ 	xPosition _ anEvent cursorPoint x.
+ 	newTab _
+ 		((self tabs detect: [ :anAssociation | | tabBounds |
+ 				tabBounds _ anAssociation key bounds.
+ 				(tabBounds left <= xPosition) and: [ tabBounds right >= xPosition]]
+ 			ifNone: [nil])
+ 		key).
+ 	newTab ifNil: [^ self].
+ 	newTab = activeTab ifFalse: [ self activeTab: newTab ]
+ !

Item was added:
+ ----- Method: PluggableTabBarMorph>>performActiveTabAction (in category 'actions') -----
+ performActiveTabAction
+ 	"Look up the Symbol or Block associated with the currently active tab, and perform it."
+ 	
+ 	| tabActionAssoc aSymbolOrBlock |
+ 	
+ 	tabActionAssoc _ self tabs detect: [ :assoc | assoc key = self activeTab.] ifNone: [ Association new ].
+ 	aSymbolOrBlock _ tabActionAssoc value.
+ 	aSymbolOrBlock ifNil: [ ^ false ].
+ 	^ aSymbolOrBlock isSymbol
+ 		ifTrue: [ self target perform: aSymbolOrBlock ]
+ 		ifFalse: [ aSymbolOrBlock value ].
+ 	!

Item was added:
+ ----- Method: PluggableTabBarMorph>>tabs (in category 'private - access') -----
+ tabs
+ 	tabs ifNil: [ tabs _ OrderedCollection new ].
+ 	^ tabs!

Item was added:
+ ----- Method: PluggableTabBarMorph>>target (in category 'private - access') -----
+ target
+ 	^ target!

Item was added:
+ ----- Method: PluggableTabBarMorph>>target: (in category 'access') -----
+ target: anObject
+ 	target _ anObject!

Item was added:
+ ----- Method: PluggableTextMorph>>fontsForText (in category '*Etoys-Squeakland-classification') -----
+ fontsForText
+ 	"I encapsulate a TextMorph, and need to show halo handles for text font commands."
+ 	^ true!

Item was added:
+ ----- Method: Point class>>readEToyPointFrom: (in category '*Etoys-Squeakland-instance creation') -----
+ readEToyPointFrom: aString
+ 	"Answer a point as described in the string"
+ 
+ 	| atPos xString yString |
+ 	atPos := aString indexOf: $@ ifAbsent: [nil].
+ 	
+ 	xString := atPos
+ 		ifNil:
+ 			 [aString]
+ 		ifNotNil:
+ 			[aString copyFrom: 1 to: (atPos - 1)].
+ 	yString := atPos
+ 		ifNil:
+ 			[aString]
+ 		ifNotNil:
+ 			[aString copyFrom: (atPos + 1) to: aString size].
+ 
+ 	^ (Number readEToyNumberFrom: xString) @ (Number readEToyNumberFrom: yString)
+ "
+ Point readEToyPointFrom:  '2.345 @ -23.49'
+ "!

Item was added:
+ ----- Method: Point>>grouped (in category '*Etoys-Squeakland-arithmetic') -----
+ grouped
+ 	"Sent as a pseudo-function for parenthesizing in tile scripts."
+ 
+ 	^ self!

Item was added:
+ ----- Method: Point>>hashMappedBy: (in category '*Etoys-Squeakland-comparing') -----
+ hashMappedBy: map
+ 	"My hash is independent of my oop."
+ 
+ 	^self hash!

Item was added:
+ DataType subclass: #PointType
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Protocols-Type Vocabularies'!
+ 
+ !PointType commentStamp: 'sw 2/8/2012 17:57' prior: 0!
+ A value type whose representing Point-valued variables.!

Item was added:
+ ----- Method: PointType>>addExtraItemsToMenu:forSlotSymbol: (in category 'defaults') -----
+ addExtraItemsToMenu: aMenu forSlotSymbol: slotSym
+ 	"If the receiver has extra menu items to add to the slot menu, here is its chance to do it.  The defaultTarget of the menu is the player concerned."
+ 
+ 	aMenu add: 'decimal places...' translated selector: #setPrecisionFor: argument: slotSym.
+ 	aMenu balloonTextForLastItem: 'Lets you choose how many decimal places should be shown in readouts for this variable' translated!

Item was added:
+ ----- Method: PointType>>defaultArgumentTile (in category 'defaults') -----
+ defaultArgumentTile
+ 	"Answer a tile to represent the type"
+ 
+ 	^ (0 at 0) newTileMorphRepresentative typeColor: self typeColor!

Item was added:
+ ----- Method: PointType>>initialValueForASlotFor: (in category 'defaults') -----
+ initialValueForASlotFor: aPlayer
+ 	"Answer the value to give initially to a newly created slot of the given type in the given player"
+ 
+ 	^  0 at 0!

Item was added:
+ ----- Method: PointType>>initialize (in category 'defaults') -----
+ initialize
+ 	"Initialize the receiver"
+ 
+ 	super initialize.
+ 	self vocabularyName: #Point!

Item was added:
+ ----- Method: PointType>>newReadoutTile (in category 'tiles') -----
+ newReadoutTile
+ 	"Answer a tile that can serve as a readout for data of this type"
+ 
+ 	| aTile |
+ 	aTile := NumericReadoutTile new typeColor: Color lightGray lighter.
+ 	aTile setProperty: #PointValued toValue: true.
+ 	^ aTile!

Item was added:
+ ----- Method: PointType>>wantsArrowsOnTiles (in category 'defaults') -----
+ wantsArrowsOnTiles
+ 	"Answer whether this data type wants up/down arrows on tiles representing its values"
+ 
+ 	^ false!

Item was added:
+ ----- Method: PointType>>wantsAssignmentTileVariants (in category 'tiles') -----
+ wantsAssignmentTileVariants
+ 	"Answer whether an assignment tile for a variable of this type should show variants to increase-by, decrease-by, multiply-by."
+ 
+ 	^ true!

Item was added:
+ ----- Method: PointType>>wantsSuffixArrow (in category 'defaults') -----
+ wantsSuffixArrow
+ 	"Answer whether a tile showing data of this type would like to have a suffix arrow"
+ 
+ 	^ true!

Item was added:
+ ----- Method: PolygonMorph class>>curvePrototype (in category '*Etoys-Squeakland-instance creation') -----
+ curvePrototype
+ 	"Answer an instance of the receiver that will serve as a prototypical curve"
+ 
+ 	| aa |
+ 	aa _ self new. 
+ 	aa vertices: (Array with: 0 at 80 with: 70 at 90 with: 60 at 0) 
+ 		color: Color orange lighter 
+ 		borderWidth: 4 
+ 		borderColor: Color black.
+ 	aa beSmoothCurve.
+ 	aa setNameTo: 'Curve'.
+ 	aa makeForwardArrow.		"is already open"
+ 	aa computeBounds.
+ 	^ aa
+ 
+ "
+ PolygonMorph curvePrototype openInHand
+ "!

Item was added:
+ ----- Method: PolygonMorph class>>trianglePrototype (in category '*Etoys-Squeakland-instance creation') -----
+ trianglePrototype
+ 	"Answer an instance of the receiver that will serve as a prototypical triangle"
+ 
+ 	| aa |
+ 	aa _ self new. 
+ 	aa vertices: {0.0 at 0.0. 138.0 at 0.0. -37.0 at -74.0}
+ 		color:  (TranslucentColor r: 0.387 g: 1.0 b: 0.548 alpha: 0.463)
+ 		borderWidth: 3 
+ 		borderColor: Color black.
+ 	aa setProperty: #noNewVertices toValue: true.
+ 	aa setNameTo: 'Triangle'.
+ 	aa makeForwardArrow.		"is already open"
+ 	aa computeBounds.
+ 	aa addHandles.
+ 	^ aa
+ 
+ "
+ PolygonMorph trianglePrototype openInHand
+ "!

Item was added:
+ ----- Method: PolygonMorph>>appendVertex (in category '*Etoys-Squeakland-vertices operations') -----
+ appendVertex
+ 
+ 	self setVertices: (vertices copyWith: vertices last)
+ !

Item was added:
+ ----- Method: PolygonMorph>>insertVertexAtCursor (in category '*Etoys-Squeakland-vertices operations') -----
+ insertVertexAtCursor
+ 	| newVertices |
+ 	newVertices := vertices species new: vertices size + 1.
+ 	1
+ 		to: self vertexCursor
+ 		do: [:i | newVertices
+ 				at: i
+ 				put: (vertices at: i)].
+ 	newVertices
+ 		at: self vertexCursor + 1
+ 		put: (vertices at: self vertexCursor) copy.
+ 	self vertexCursor + 1
+ 		to: vertices size
+ 		do: [:i | newVertices
+ 				at: i + 1
+ 				put: (vertices at: i)].
+ 	self setVertices: newVertices!

Item was added:
+ ----- Method: PolygonMorph>>prependVertex (in category '*Etoys-Squeakland-vertices operations') -----
+ prependVertex
+ 
+ 	self setVertices: (vertices copyWithFirst: vertices first).
+ 	self vertexCursor: self vertexCursor + 1
+ !

Item was added:
+ ----- Method: PolygonMorph>>removeAllButCursor (in category '*Etoys-Squeakland-vertices operations') -----
+ removeAllButCursor
+ 	self
+ 		setVertices: (vertices copyFrom: self vertexCursor to: self vertexCursor)!

Item was added:
+ ----- Method: PolygonMorph>>removeVertexAtCursor (in category '*Etoys-Squeakland-vertices operations') -----
+ removeVertexAtCursor
+ 	| newVertices |
+ 	vertices size > 1
+ 		ifTrue: [newVertices := vertices species new: vertices size - 1.
+ 			1
+ 				to: self vertexCursor - 1
+ 				do: [:i | newVertices
+ 						at: i
+ 						put: (vertices at: i)].
+ 			self vertexCursor + 1
+ 				to: vertices size
+ 				do: [:i | newVertices
+ 						at: i - 1
+ 						put: (vertices at: i)].
+ 			self setVertices: newVertices]!

Item was added:
+ ----- Method: PolygonMorph>>setVerticesCount: (in category '*Etoys-Squeakland-vertices operations') -----
+ setVerticesCount: anInteger 
+ 	| verticesCount |
+ 	verticesCount := vertices size.
+ 	verticesCount > anInteger
+ 		ifTrue: [verticesCount - anInteger
+ 				timesRepeat: [self removeVertexAtCursor]].
+ 	verticesCount < anInteger
+ 		ifTrue: [anInteger - verticesCount
+ 				timesRepeat: [self insertVertexAtCursor]]!

Item was added:
+ ----- Method: PolygonMorph>>shuffleVertices (in category '*Etoys-Squeakland-vertices operations') -----
+ shuffleVertices
+ 
+ 	self setVertices: vertices shuffled.
+ 	self computeBounds!

Item was added:
+ ----- Method: PolygonMorph>>smoothPhrase (in category '*Etoys-Squeakland-menu') -----
+ smoothPhrase
+ 	"Answer a string characterizing whether I am currently closed."
+ 
+ 	^ (self isCurve ifTrue: ['<yes>'] ifFalse: ['<no>']), 'curve' translated!

Item was added:
+ ----- Method: PolygonMorph>>vertexAtCursor (in category '*Etoys-Squeakland-vertices operations') -----
+ vertexAtCursor
+ 
+ 	
+ 	^ self vertices at: self vertexCursor!

Item was added:
+ ----- Method: PolygonMorph>>vertexAtCursorPut: (in category '*Etoys-Squeakland-vertices operations') -----
+ vertexAtCursorPut: aPoint
+ 
+ 	
+ 	self verticesAt: self vertexCursor put: aPoint !

Item was added:
+ ----- Method: PolygonMorph>>vertexCursor (in category '*Etoys-Squeakland-vertices operations') -----
+ vertexCursor
+ 
+ 	vertexCursor isNil ifTrue: [vertexCursor _ 1].
+ 	^ vertexCursor!

Item was added:
+ ----- Method: PolygonMorph>>vertexCursor: (in category '*Etoys-Squeakland-vertices operations') -----
+ vertexCursor: anInteger 
+ 	vertexCursor = anInteger
+ 		ifFalse: [| oldCursor | 
+ 			oldCursor := vertexCursor.
+ 			vertexCursor := ((anInteger - 1) \\ vertices size) + 1.
+ 			self showingHandles
+ 				ifTrue: [(handles at: oldCursor * 2 - 1)
+ 						color: Color yellow.
+ 					self updateHandles]]!

Item was added:
+ ----- Method: PolygonMorph>>xAtCursor (in category '*Etoys-Squeakland-vertices operations') -----
+ xAtCursor
+ 	| world aPlayfield |
+ 	world := self world.
+ 	world
+ 		ifNil: [^ self vertexAtCursor x].
+ 	aPlayfield := self referencePlayfield.
+ 	^ aPlayfield isNil
+ 		ifTrue: [self vertexAtCursor x - world cartesianOrigin x]
+ 		ifFalse: [self vertexAtCursor x - aPlayfield cartesianOrigin x]!

Item was added:
+ ----- Method: PolygonMorph>>xAtCursor: (in category '*Etoys-Squeakland-vertices operations') -----
+ xAtCursor: aNumber 
+ 	| world aPlayfield newX |
+ 	world := self world.
+ 	world
+ 		ifNil: [^ self verticesAt: self vertexCursor put: aNumber @ self vertexAtCursor y].
+ 	aPlayfield := self referencePlayfield.
+ 	newX := aPlayfield isNil
+ 				ifTrue: [world cartesianOrigin x + aNumber]
+ 				ifFalse: [aPlayfield cartesianOrigin x + aNumber].
+ 	self vertexAtCursorPut: newX @ self vertexAtCursor y!

Item was added:
+ ----- Method: PolygonMorph>>yAtCursor (in category '*Etoys-Squeakland-vertices operations') -----
+ yAtCursor
+ 	| world aPlayfield |
+ 	world := self world.
+ 	world
+ 		ifNil: [^ self vertexAtCursor y].
+ 	aPlayfield := self referencePlayfield.
+ 	^ aPlayfield isNil
+ 		ifTrue: [world cartesianOrigin y - self vertexAtCursor y]
+ 		ifFalse: [aPlayfield cartesianOrigin y - self vertexAtCursor y]!

Item was added:
+ ----- Method: PolygonMorph>>yAtCursor: (in category '*Etoys-Squeakland-vertices operations') -----
+ yAtCursor: aNumber
+ 	| world newY aPlayfield |
+ 	world := self world.
+ 	world ifNil: [^self verticesAt: self vertexCursor put: self vertexAtCursor x @ aNumber].
+ 	aPlayfield := self referencePlayfield.
+ 	newY := aPlayfield isNil
+ 				ifTrue: [world cartesianOrigin y - aNumber]
+ 				ifFalse: [aPlayfield cartesianOrigin y - aNumber].
+ 	self vertexAtCursorPut: self vertexAtCursor x @ newY!

Item was added:
+ ----- Method: PopUpMenu class>>informCenteredAboveCursor: (in category '*Etoys-Squeakland-dialogs') -----
+ informCenteredAboveCursor: aString
+ 	"Put up an informer showing the given string in a box, with the OK button for dismissing the informer having the cursor at its center."
+ 
+ 	"PopUpMenu informCenteredAboveCursor: 'I like Squeak
+ how about you?'"
+ 
+ 	| lines maxWid xCoor |
+ 	lines := Array streamContents: [:aStream |
+ 		aString linesDo: [:l | aStream nextPut: l]].
+ 	maxWid := (lines collect: [:l |  Preferences standardMenuFont widthOfString: l]) max.
+ 	xCoor := ActiveHand cursorPoint x - (maxWid // 2).
+ 	((xCoor + maxWid) > ActiveWorld right) ifTrue:
+ 		[xCoor := ActiveWorld right].  "Caters to problematic PopUpMenu boundary behavior"
+ 
+ 	(PopUpMenu labels: 'OK' translated) startUpWithCaption: aString
+ 			at: (xCoor  @ ActiveHand cursorPoint y)
+ 			allowKeyboard: true centered: true
+ 
+ !

Item was added:
+ ----- Method: PopUpMenu>>startUpWithCaption:at:allowKeyboard:centered: (in category '*Etoys-Squeakland-basic control sequence') -----
+ startUpWithCaption: captionOrNil at: location allowKeyboard: allowKeyboard centered: centered
+ 	"Display the menu, with caption if supplied. Wait for the mouse button to go down, then track the selection as long as the button is pressed. When the button is released,
+ 	Answer the index of the current selection, or zero if the mouse is not released over  any menu item. Location specifies the desired topLeft of the menu body rectangle. The final argument indicates whether the menu should seize the keyboard focus in order to allow the user to navigate it via the keyboard
+ 	If centered is true, the menu items are displayed centered.."
+ 
+ 	| maxHeight aMenu |
+ 	(ProvideAnswerNotification signal: captionOrNil) ifNotNilDo:
+ 		[:answer | ^ selection _ answer ifTrue: [1] ifFalse: [2]].
+ 		 
+ 	maxHeight _ Display height*3//4.
+ 	self frameHeight > maxHeight ifTrue:
+ 		[^ self
+ 			startUpSegmented: maxHeight
+ 			withCaption: captionOrNil
+ 			at: location
+ 			allowKeyboard: allowKeyboard].
+ 
+ 	Smalltalk isMorphic
+ 		ifTrue:[
+ 			selection _ Cursor normal showWhile:
+ 				[aMenu := MVCMenuMorph from: self title: captionOrNil.
+ 				centered ifTrue:
+ 					[aMenu submorphs allButFirst do:
+ 						[:m | m setProperty: #centered toValue: true]].
+ 				aMenu
+ 					invokeAt: location 
+ 					in: ActiveWorld
+ 					allowKeyboard: allowKeyboard].
+ 			^ selection].
+ 
+ 	frame ifNil: [self computeForm].
+ 	Cursor normal showWhile:
+ 		[self
+ 			displayAt: location
+ 			withCaption: captionOrNil
+ 			during: [self controlActivity]].
+ 	^ selection!

Item was added:
+ WordNet subclass: #PortugueseLexiconServer
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-TelNet WordNet'!
+ 
+ !PortugueseLexiconServer commentStamp: '<historical>' prior: 0!
+ Provide a standard interface for the Portuguese language dictionary at http://www.priberam.pt/.
+ The "choose language" item on the shift-menu lets you select a language (and its server).  (Preferences setPreference: #myLanguage toValue: #Portuguese).  To get the definition of a word, select any word in any text pane, and choose "definition of word" from the shift menu.  Also used for the "verify spelling of word" menu item.
+ 
+ PortugueseLexiconServer openScamperOn: 'palavra'.
+ 
+ See class WordNet.
+ Converts an input string from Apple character encoding to the encoding used on this server.
+   'particípio' -> 'particÌpio'
+ 
+ Not yet completed:
+ ** Better parse of the definition page, so it can be used by a program.!

Item was added:
+ ----- Method: PortugueseLexiconServer class>>decodeAccents: (in category 'as yet unclassified') -----
+ decodeAccents: appleLikeString
+ 	"change characters like í, to the form used in Portuguese"
+ 	| encodedStream rem |
+ 	encodedStream _ WriteStream on: (String new).
+ 	
+ 	appleLikeString do: [ :c |
+ 		rem _ encodedStream position.
+ 		c == $í ifTrue: [encodedStream nextPut: (Character value: 237)].
+ 		c == $á ifTrue: [encodedStream nextPut: (Character value: 225)].
+ 		c == $é ifTrue: [encodedStream nextPut: (Character value: 233)].
+ 		c == $ç ifTrue: [encodedStream nextPut: (Character value: 231)].
+ 		c == $ã ifTrue: [encodedStream nextPut: (Character value: 227)].
+ 		c == $ó ifTrue: [encodedStream nextPut: (Character value: 243)].
+ 		c == $ê ifTrue: [encodedStream nextPut: (Character value: 234)].
+ 		"and more, such as e with a backwards accent"
+ 
+ 		rem = encodedStream position ifTrue: [
+ 			encodedStream nextPut: c].
+ 		].
+ 	^encodedStream contents. !

Item was added:
+ ----- Method: PortugueseLexiconServer class>>openScamperOn: (in category 'as yet unclassified') -----
+ openScamperOn: aWord
+ 	| aUrl scamperWindow |
+ 	"Open a Scamper web browser on the web dictionary entry for this word.  If Scamper is already pointing at it, use the same browser.  Special code for this server."
+ 
+ 	aUrl _ 'http://www.priberam.pt/scripts/dlpouniv.dll', 
+ 		'?search_value=', (self decodeAccents: aWord).
+ 	scamperWindow _ (WebBrowser default ifNil: [^self]) newOrExistingOn: aUrl.
+ 	scamperWindow model jumpToUrl: aUrl asUrl.
+ 	scamperWindow activate.
+ !

Item was added:
+ ----- Method: PortugueseLexiconServer>>definition: (in category 'as yet unclassified') -----
+ definition: theWord
+ 	"look this word up in the basic way.  Return nil if there is trouble accessing the web site."
+ 	| doc |
+ 
+ 	word _ theWord.
+ 	doc _ HTTPSocket 
+ 		httpGetDocument: 'http://www.priberam.pt/scripts/dlpouniv.dll' 
+ 		args: 'search_value=', (self class decodeAccents: word).
+ 	replyHTML _ (doc isKindOf: MIMEDocument)
+ 		ifTrue: [doc content]
+ 		ifFalse: [nil].
+ 	"self parseReply."
+ 
+ 	^ replyHTML!

Item was added:
+ ----- Method: PortugueseLexiconServer>>parts (in category 'as yet unclassified') -----
+ parts
+ 	| divider |
+ 	"return the parts of speech this word can be.  Keep the streams for each"
+ 	parts _ OrderedCollection new.
+ 	partStreams _ OrderedCollection new.
+ 	rwStream ifNil: [self stream].
+ 	rwStream reset.
+ 	rwStream match: 'Palavra desconhecida pelo Dicionário.'.
+ 	rwStream atEnd ifFalse: [^ #()].	"not in dictionary"
+ 
+ 	rwStream reset.
+ 	rwStream match: (divider _ '<li>').	"stemming a complex word"
+ 	rwStream atEnd ifTrue: [rwStream reset.
+ 		rwStream match: (divider _ '<dd>')].	"base word in dict"
+ 	[rwStream atEnd] whileFalse: [
+ 		partStreams add: (ReadStream on: (rwStream upToAll: divider))].
+ 	partStreams do: [:pp |
+ 		parts add: (pp upToAll: '</b>')].
+ 	parts size = 0 ifTrue: [^ parts].
+ 	parts last = '' ifTrue: [parts removeLast.  partStreams removeLast].
+ 		"May want to remove all after </dl>"
+ 	^ parts !

Item was added:
+ ----- Method: PostscriptCharacterScanner>>placeEmbeddedObject: (in category '*Etoys-Squeakland-textstyle support') -----
+ placeEmbeddedObject: anchoredMorph
+ !

Item was added:
+ SystemWindow subclass: #PreDebugWindow
+ 	instanceVariableNames: 'proceedButton debugButton'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Windows'!

Item was added:
+ ----- Method: PreDebugWindow class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 	^ false!

Item was added:
+ ----- Method: PreDebugWindow>>adjustBookControls (in category 'as yet unclassified') -----
+ adjustBookControls
+ 	| inner |
+ 	proceedButton ifNil: [^ self].
+ 	proceedButton align: proceedButton topLeft with: (inner _ self innerBounds) topLeft + (35 at -4).
+ 	debugButton align: debugButton topRight with: inner topRight - (16 at 4).!

Item was added:
+ ----- Method: PreDebugWindow>>createMethod (in category 'as yet unclassified') -----
+ createMethod
+ 	model createMethod!

Item was added:
+ ----- Method: PreDebugWindow>>debug (in category 'as yet unclassified') -----
+ debug
+ 	model debug!

Item was added:
+ ----- Method: PreDebugWindow>>extent: (in category 'geometry') -----
+ extent: newExtent
+ 	super extent: (newExtent max: 100 @ 50).
+ 	self adjustBookControls!

Item was added:
+ ----- Method: PreDebugWindow>>initialize (in category 'initialization') -----
+ initialize
+ 	| aFont proceedLabel debugLabel aWidth |
+ 	super initialize.
+ 	true 
+ 		ifFalse: 
+ 			["Preferences optionalMorphicButtons"
+ 
+ 			(aWidth := self widthOfFullLabelText) > 280 ifTrue: [^self].	"No proceed/debug buttons if title too long"
+ 			debugLabel := aWidth > 210 
+ 				ifTrue: 
+ 					["Abbreviated buttons if title pretty long"
+ 
+ 					proceedLabel := 'p'.
+ 					'd']
+ 				ifFalse: 
+ 					["Full buttons if title short enough"
+ 
+ 					proceedLabel := 'proceed'.
+ 					'debug'].
+ 			aFont := Preferences standardEToysButtonFont.
+ 			self addMorph: (proceedButton := (SimpleButtonMorph new)
+ 								borderWidth: 0;
+ 								label: proceedLabel font: aFont;
+ 								color: Color transparent;
+ 								actionSelector: #proceed;
+ 								target: self).
+ 			proceedButton setBalloonText: 'continue execution'.
+ 			self addMorph: (debugButton := (SimpleButtonMorph new)
+ 								borderWidth: 0;
+ 								label: debugLabel font: aFont;
+ 								color: Color transparent;
+ 								actionSelector: #debug;
+ 								target: self).
+ 			debugButton setBalloonText: 'bring up a debugger'.
+ 			proceedButton submorphs first color: Color blue.
+ 			debugButton submorphs first color: Color red].
+ 	self adjustBookControls!

Item was added:
+ ----- Method: PreDebugWindow>>proceed (in category 'as yet unclassified') -----
+ proceed
+ 	model proceed!

Item was added:
+ ----- Method: PreDebugWindow>>setBalloonTextForCloseBox (in category 'as yet unclassified') -----
+ setBalloonTextForCloseBox
+ 	closeBox ifNotNil:
+ 		[closeBox setBalloonText: 'abandon this execution by closing this window' translated].
+ !

Item was added:
+ ----- Method: PreDebugWindow>>setLabelWidgetAllowance (in category 'label') -----
+ setLabelWidgetAllowance
+ 	^ labelWidgetAllowance _ (Smalltalk isMorphic | Preferences optionalButtons)
+ 		ifTrue:
+ 			[super setLabelWidgetAllowance]
+ 		ifFalse:
+ 			[180]!

Item was added:
+ ----- Method: PreDebugWindow>>storeLog (in category 'as yet unclassified') -----
+ storeLog
+ 	model storeLog!

Item was added:
+ ArrayedCollection subclass: #PredicatedArray
+ 	instanceVariableNames: 'predicates values type'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tweak-Kedama-ObjectVectors'!

Item was added:
+ ----- Method: PredicatedArray class>>new: (in category 'instance creation') -----
+ new: size
+ 
+ 	| inst elems |
+ 	inst _ self basicNew.
+ 	elems _ ByteArray new: size withAll: 1.
+ 	inst predicates: elems values: elems.
+ 	^ inst.
+ !

Item was added:
+ ----- Method: PredicatedArray class>>newFor: (in category 'instance creation') -----
+ newFor: anArrayedCollection
+ 
+ 	| inst predicates |
+ 	inst _ self basicNew.
+ 	predicates _ ByteArray new: anArrayedCollection size.
+ 	inst predicates: predicates values: anArrayedCollection.
+ 	^ inst.
+ !

Item was added:
+ ----- Method: PredicatedArray class>>predicates:values: (in category 'instance creation') -----
+ predicates: predicates values: anArrayedCollection
+ 
+ 	^  self new predicates: predicates values: anArrayedCollection.
+ !

Item was added:
+ ----- Method: PredicatedArray class>>predicates:values:type: (in category 'instance creation') -----
+ predicates: predicates values: anArrayedCollection type: typeSymbol
+ 
+ 	^  self new predicates: predicates values: anArrayedCollection type: typeSymbol
+ !

Item was added:
+ ----- Method: PredicatedArray>>asPredicate (in category 'converting') -----
+ asPredicate
+ 
+ 	predicates _ values.
+ !

Item was added:
+ ----- Method: PredicatedArray>>at: (in category 'slot accessing') -----
+ at: index
+ 
+ 	^ values at: index.
+ !

Item was added:
+ ----- Method: PredicatedArray>>at:put: (in category 'slot accessing') -----
+ at: index put: anObject
+ 
+ 	^ values at: index put: anObject.
+ !

Item was added:
+ ----- Method: PredicatedArray>>atAllBasicPut: (in category 'enumeration') -----
+ atAllBasicPut: aValue
+ 
+ 	self indexDo: [:index |
+ 		values basicAt: index put: aValue.
+ 	].
+ !

Item was added:
+ ----- Method: PredicatedArray>>atAllPut: (in category 'enumeration') -----
+ atAllPut: anObject
+ 
+ 	type = #Number ifTrue: [
+ 		self primAtAllPutNumber: anObject asFloat.
+ 		^ self.
+ 	].
+ 	type = #Object ifTrue: [
+ 		self primAtAllPutObject: anObject.
+ 		^ self.
+ 	].
+ 	type = #Color ifTrue: [
+ 		self primAtAllPutColor: anObject.
+ 		^ self.
+ 	].
+ 	type = #Boolean ifTrue: [
+ 		self primAtAllPutBoolean: anObject.
+ 		^ self.
+ 	].
+ 
+ !

Item was added:
+ ----- Method: PredicatedArray>>do: (in category 'enumeration') -----
+ do: aBlock
+ 
+ 	1 to: (values size min: predicates size) do: [:index |
+ 		(predicates at: index) = 1 ifTrue: [
+ 			aBlock value: (values at: index).
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: PredicatedArray>>from:to:put: (in category 'enumeration') -----
+ from: from to: to put: anObject
+ 
+ 	self indexDo: [:index |
+ 		(index between: from and: to) ifTrue: [
+ 			self at: index put: anObject.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: PredicatedArray>>indexDo: (in category 'enumeration') -----
+ indexDo: aBlock
+ 
+ 	1 to: (values size min: predicates size) do: [:index |
+ 		(predicates at: index) = 1 ifTrue: [
+ 			aBlock value: index.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: PredicatedArray>>predicates (in category 'accessing') -----
+ predicates
+ 
+ 	^ predicates.
+ !

Item was added:
+ ----- Method: PredicatedArray>>predicates: (in category 'accessing') -----
+ predicates: anArray
+ 
+ 	predicates _ anArray.
+ !

Item was added:
+ ----- Method: PredicatedArray>>predicates:values: (in category 'initialization') -----
+ predicates: anObject values: anotherObject
+ 
+ 	predicates _ anObject.
+ 	values _ anotherObject.
+ !

Item was added:
+ ----- Method: PredicatedArray>>predicates:values:type: (in category 'initialization') -----
+ predicates: anObject values: anotherObject type: typeSymbol
+ 
+ 	predicates _ anObject.
+ 	values _ anotherObject.
+ 	type _ typeSymbol.
+ !

Item was added:
+ ----- Method: PredicatedArray>>primAtAllPutBoolean: (in category 'primitives') -----
+ primAtAllPutBoolean: val
+ 
+ 	| b |
+ 	<primitive: 'primitivePredicateAtAllPutBoolean' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitivePredicateAtAllPutBoolean."
+ 
+ 	b _ (val == true or: [val == false]) ifTrue: [
+ 			val ifTrue: [1] ifFalse: [0].
+ 		] ifFalse: [val].
+ 
+ 	1 to: (values size min: predicates size) do: [:index |
+ 		(predicates at: index) = 1 ifTrue: [
+ 			values at: index put: b.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: PredicatedArray>>primAtAllPutColor: (in category 'primitives') -----
+ primAtAllPutColor: val
+ 
+ 	| p |
+ 	<primitive: 'primitivePredicateAtAllPutColor' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitivePredicateAtAllPutColor."
+ 
+ 	p _ val bitOr: 16rFF000000.
+ 	1 to: (values size min: predicates size) do: [:index |
+ 		(predicates at: index) = 1 ifTrue: [
+ 			values at: index put: p.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: PredicatedArray>>primAtAllPutNumber: (in category 'primitives') -----
+ primAtAllPutNumber: val
+ 
+ 	<primitive: 'primitivePredicateAtAllPutNumber' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitivePredicateAtAllPutNumber."
+ 
+ 	1 to: (values size min: predicates size) do: [:index |
+ 		(predicates at: index) = 1 ifTrue: [
+ 			values at: index put: val.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: PredicatedArray>>primAtAllPutObject: (in category 'primitives') -----
+ primAtAllPutObject: val
+ 
+ 	<primitive: 'primitivePredicateAtAllPutObject' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitivePredicateAtAllPutObject."
+ 
+ 	1 to: (values size min: predicates size) do: [:index |
+ 		(predicates at: index) = 1 ifTrue: [
+ 			values at: index put: val.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: PredicatedArray>>primReplaceBytesFrom:to:with:startingAt: (in category 'primitives') -----
+ primReplaceBytesFrom: start to: stop with: replacement startingAt: repStart
+ 
+ 	| v |
+ 	<primitive: 'primitivePredicateReplaceBytes' module: 'KedamaPlugin2'>
+ 	^ KedamaPlugin2 doPrimitive: #primitivePredicateReplaceBytes.
+ "
+ 	self indexDo: [:index |
+ 		(index between: start and: stop) ifTrue: [
+ 			v _ replacement at: repStart + index - start.
+ 			self at: index put: v.
+ 		].
+ 	].
+ "!

Item was added:
+ ----- Method: PredicatedArray>>primReplaceWordsFrom:to:with:startingAt: (in category 'primitives') -----
+ primReplaceWordsFrom: start to: stop with: replacement startingAt: repStart
+ 
+ 	| v |
+ 	<primitive: 'primitivePredicateReplaceWords' module: 'KedamaPlugin2'>
+ 	"^ KedamaPlugin2 doPrimitive: #primitivePredicateReplaceWords."
+ 
+ 	self indexDo: [:index |
+ 		(index between: start and: stop) ifTrue: [
+ 			v _ replacement at: repStart + index - start.
+ 			self at: index put: v.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: PredicatedArray>>printElementsOn: (in category 'printing') -----
+ printElementsOn: aStream
+ 	aStream nextPut: $(.
+ 	1 to: values size do: [:index | aStream print: (self at: index); space].
+ 	self isEmpty ifFalse: [aStream skip: -1].
+ 	aStream nextPut: $)!

Item was added:
+ ----- Method: PredicatedArray>>replaceFrom:to:with:startingAt: (in category 'enumeration') -----
+ replaceFrom: start to: stop with: replacement startingAt: repStart
+ 
+ 	(type = #Number or: [type = #Object or: [type = #Color]]) ifTrue: [
+ 		self primReplaceWordsFrom: start to: stop with: replacement startingAt: repStart.
+ 		^ self.
+ 	].
+ 	type = #Boolean ifTrue: [
+ 		self primReplaceBytesFrom: start to: stop with: replacement startingAt: repStart.
+ 		^ self.
+ 	].
+ !

Item was added:
+ ----- Method: PredicatedArray>>size (in category 'accessing') -----
+ size
+ 
+ 	^ values size.
+ !

Item was added:
+ ----- Method: PredicatedArray>>type (in category 'accessing') -----
+ type
+ 
+ 	^ type.
+ !

Item was added:
+ ----- Method: PredicatedArray>>type: (in category 'accessing') -----
+ type: aSymbol
+ 
+ 	type _ aSymbol.
+ !

Item was added:
+ ----- Method: PredicatedArray>>values (in category 'accessing') -----
+ values
+ 
+ 	^ values.
+ !

Item was added:
+ ----- Method: PredicatedArray>>values: (in category 'accessing') -----
+ values: anArray
+ 
+ 	values _ anArray.
+ !

Item was added:
+ ----- Method: Preference>>isDisabledOnStartupString (in category '*Etoys-Squeakland-persistence') -----
+ isDisabledOnStartupString
+ 	"Answer a string representing whether this preference is persisted to false"
+ 
+ 	| aStr |
+ 	aStr :=  'disable preference on startup' translated.
+ 	^ self persistedValue == false
+ 		ifTrue: ['<yes>', aStr]
+ 		ifFalse: 	['<no>', aStr]!

Item was added:
+ ----- Method: Preference>>isEnabledOnStartupString (in category '*Etoys-Squeakland-persistence') -----
+ isEnabledOnStartupString
+ 	"Answer a string representing whether this preference is persisted to true"
+ 
+ 	| aStr |
+ 	aStr :=  'enable preference on startup' translated.
+ 	^ self persistedValue == true
+ 		ifTrue: ['<yes>', aStr]
+ 		ifFalse: 	['<no>', aStr]!

Item was added:
+ ----- Method: Preference>>isNotSetOnStartupString (in category '*Etoys-Squeakland-persistence') -----
+ isNotSetOnStartupString
+ 	"Answer a string representing whether this preference is not persisted"
+ 
+ 	| aStr |
+ 	aStr :=  'do not set preference on startup' translated.
+ 	^ self persistedValue == nil
+ 		ifTrue: ['<yes>', aStr]
+ 		ifFalse: 	['<no>', aStr]!

Item was added:
+ ----- Method: Preference>>persistValue: (in category '*Etoys-Squeakland-persistence') -----
+ persistValue: aBooleanOrNil
+ 	"Save this preference on file, so it can be restored on startup. If nil, delete persistent value."
+ 	Preferences persistValue: aBooleanOrNil for: self name!

Item was added:
+ ----- Method: Preference>>persistedValue (in category '*Etoys-Squeakland-persistence') -----
+ persistedValue
+ 	"Answer the value of this preference saved on file, otherwise nil"
+ 	^Preferences persistedValueFor: self name!

Item was added:
+ ----- Method: Preferences class>>addPreferenceForCelesteShowingAttachmentsFlag (in category '*Etoys-Squeakland-initialization') -----
+ addPreferenceForCelesteShowingAttachmentsFlag
+ 	"Assure the existence of a preference governing the showing of the celeste attachments flag"
+ 
+ 	"Preferences addPreferenceForCelesteShowingAttachmentsFlag"
+ 	self preferenceAt: #celesteShowsAttachmentsFlag ifAbsent:
+ 		[self
+ 				addPreference: #celesteShowsAttachmentsFlag
+ 				category: #general
+ 				default: false
+ 				balloonHelp: 'If true, Celeste (e-mail reader) annotates messages in it''s list that have attachments.  This is a performance hit and by default is off.' translatedNoop ]!

Item was added:
+ ----- Method: Preferences class>>addPreferenceForOptionalCelesteStatusPane (in category '*Etoys-Squeakland-initialization') -----
+ addPreferenceForOptionalCelesteStatusPane
+ 	"Assure existence of a preference that governs the optional celeste status pane"
+ 
+ 	"Preferences addPreferenceForOptionalCelesteStatusPane"
+ 	self preferenceAt: #celesteHasStatusPane ifAbsent:
+ 		[self
+ 			addPreference: #celesteHasStatusPane
+ 			category: #general
+ 			default: false
+ 			balloonHelp: 'If true, Celeste (e-mail reader) includes a status pane.' translatedNoop
+ 		"Because Lex doesn't like it the default is false :)"]!

Item was added:
+ ----- Method: Preferences class>>allowCelesteTell (in category '*Etoys-Squeakland-standard queries') -----
+ allowCelesteTell
+ 	^ self
+ 		valueOfFlag: #allowCelesteTell
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>alternativeScrollbarLook (in category '*Etoys-Squeakland-standard queries') -----
+ alternativeScrollbarLook
+ 	^ self
+ 		valueOfFlag: #alternativeScrollbarLook
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>alternativeWindowLook (in category '*Etoys-Squeakland-standard queries') -----
+ alternativeWindowLook
+ 	^ self
+ 		valueOfFlag: #alternativeWindowLook
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>ansiAssignmentOperatorWhenPrettyPrinting (in category '*Etoys-Squeakland-standard queries') -----
+ ansiAssignmentOperatorWhenPrettyPrinting
+ 	^ self
+ 		valueOfFlag: #ansiAssignmentOperatorWhenPrettyPrinting
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>autoAccessors (in category '*Etoys-Squeakland-standard queries') -----
+ autoAccessors
+ 	^ self
+ 		valueOfFlag: #autoAccessors
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>biggerCursors (in category '*Etoys-Squeakland-standard queries') -----
+ biggerCursors
+ 	^ self
+ 		valueOfFlag: #biggerCursors
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>blinkParen (in category '*Etoys-Squeakland-standard queries') -----
+ blinkParen
+ 	^ self
+ 		valueOfFlag: #blinkParen
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>browseWithDragNDrop (in category '*Etoys-Squeakland-standard queries') -----
+ browseWithDragNDrop
+ 	^ self
+ 		valueOfFlag: #browseWithDragNDrop
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>browseWithPrettyPrint (in category '*Etoys-Squeakland-standard queries') -----
+ browseWithPrettyPrint
+ 	^ self
+ 		valueOfFlag: #browseWithPrettyPrint
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>browserNagIfNoClassComment (in category '*Etoys-Squeakland-standard queries') -----
+ browserNagIfNoClassComment
+ 	^ self
+ 		valueOfFlag: #browserNagIfNoClassComment
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>browserShowsPackagePane (in category '*Etoys-Squeakland-standard queries') -----
+ browserShowsPackagePane
+ 	^ self
+ 		valueOfFlag: #browserShowsPackagePane
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>cambridge (in category '*Etoys-Squeakland-themes') -----
+ cambridge
+ 	"A theme for Squeakland and OLPC project"
+ 	"Preferences cambridge"
+ 	"This method has three parts.  Don't forget to look at the stuff at the bottom."
+ 
+ 	self setPreferencesFrom: #(
+ 		(allowCelesteTell false)
+ 		(alternativeScrollbarLook true)
+ 		(alternativeWindowLook true)
+ 		(annotationPanes true)
+ 		(automaticKeyGeneration true)
+ 		(biggerHandles true)
+ 		(blinkParen false)
+ 		(browseWithDragNDrop true)
+ 		(canRecordWhilePlaying true)
+ 		(classicNavigatorEnabled false)
+ 		(compactViewerFlaps true)
+ 		(enableLocalSave false)
+ 		(escapeKeyProducesMenu false)
+ 		(eToyFriendly true)
+ 		(eToyLoginEnabled true)
+ 		(extraDebuggerButtons false)
+ 		(gradientMenu false)
+ 		(haloTransitions false)
+ 		(honorDesktopCmdKeys true)
+ 		(includeSoundControlInNavigator true)
+ 		(magicHalos false)
+ 		(menuAppearance3d false)
+ 		(menuKeyboardControl false)
+ 		(modalColorPickers true)
+ 		(mouseOverHalos false)
+ 		(mvcProjectsAllowed false)
+ 		(preserveTrash true)
+ 		(projectViewsInWindows false)
+ 		(promptForUpdateServer false)
+ 		(propertySheetFromHalo false)
+ 		(roundedMenuCorners false)
+ 		(roundedWindowCorners false)
+ 		(securityChecksEnabled true)
+ 		(showDirectionHandles false)
+ 		(showDirectionForSketches true)
+ 		(showProjectNavigator false)
+ 		(showSecurityStatus false)
+ 		(soundQuickStart true)	"see setPlatformPreferences"
+ 		(soundReverb false)
+ 		(soundStopWhenDone true) 	"see setPlatformPreferences"
+ 		(startInUntrustedDirectory true)
+ 		(sugarAutoSave false)
+ 		(swapControlAndAltKeys false)	"see setPlatformPreferences"
+ 		(uniqueNamesInHalos true)
+ 		(unlimitedPaintArea false)
+ 		(useArtificialSweetenerBar true)
+ 		(useBiggerPaintingBox true)
+ 		(useFormsInPaintBox false)
+ 		(useLocale true)
+ 		(usePangoRenderer false)
+ 		(usePlatformFonts false)
+ 		(usePopUpArrows true)
+ 		(warnAboutInsecureContent false)
+ 
+ 	"The following is to make sure the default is set properly."
+ 
+ 	(abbreviatedBrowserButtons false)
+ 	(allowEtoyUserCustomEvents false)
+ 	(alphabeticalProjectMenu false)
+ 	(alternativeBrowseIt false)
+ 	(alternativeButtonsInScrollBars false)
+ 	(alternativeWindowBoxesLook true)
+ 	(alwaysHideHScrollbar false)
+ 	(alwaysShowConnectionVocabulary false)
+ 	(alwaysShowHScrollbar false)
+ 	(alwaysShowVScrollbar true)
+ 	(ansiAssignmentOperatorWhenPrettyPrinting true)
+ 	(areaFillsAreTolerant false)
+ 	(areaFillsAreVeryTolerant false)
+ 	(autoAccessors false)
+ 	(automaticFlapLayout true)
+ 	(automaticPlatformSettings true)	"enables setPlatformPreferences"
+ 	(automaticViewerPlacement true)
+ 	(balloonHelpEnabled true)
+ 	(balloonHelpInMessageLists false)
+ 	(batchPenTrails false)
+ 	(biggerCursors true)
+ 	(browserNagIfNoClassComment true)
+ 	(browserShowsPackagePane false)
+ 	(browseWithPrettyPrint false)
+ 	(capitalizedReferences true)
+ 	(caseSensitiveFinds false)
+ 	(cautionBeforeClosing false)
+ 	(celesteHasStatusPane false)
+ 	(celesteShowsAttachmentsFlag false)
+ 	(changeSetVersionNumbers true)
+ 	(checkForSlips true)
+ 	(checkForUnsavedProjects true)
+ 	(classicNewMorphMenu false)
+ 	(clickOnLabelToEdit false)
+ 	(cmdDotEnabled true)
+ 	(collapseWindowsInPlace false)
+ 	(colorWhenPrettyPrinting false)
+ 	(compressFlashImages false)
+ 	(confirmFirstUseOfStyle true)
+ 	(conversionMethodsAtFileOut false)
+ 	(cpuWatcherEnabled false)
+ 	(debugHaloHandle false)
+ 	(debugPrintSpaceLog false)
+ 	(debugShowDamage false)
+ 	(decorateBrowserButtons true)
+ 	(defaultFileOutFormatMacRoman false)
+ 	(diffsInChangeList true)
+ 	(diffsWithPrettyPrint false)
+ 	(dismissAllOnOptionClose false)
+ 	(dismissEventTheatreUponPublish true)
+ 	(dragNDropWithAnimation false)
+ 	(dropProducesWatcher true)
+ 	(duplicateControlAndAltKeys false)
+ 	(easySelection false)
+ 	(enableInternetConfig false)
+ 	(enablePortraitMode false)
+ 	(enableVirtualOLPCDisplay false)
+ 	(expandedPublishing true)
+ 	(extractFlashInHighestQuality false)
+ 	(extractFlashInHighQuality true)
+ 	(fastDragWindowForMorphic true)
+ 	(fenceEnabled true)
+ 	(fenceSoundEnabled false)
+ 	(fullScreenLeavesDeskMargins true)
+ 	(gradientScrollBars true)
+ 	(haloEnclosesFullBounds false)
+ 	(higherPerformance false)
+ 	(ignoreStyleIfOnlyBold true)
+ 	(implicitSelfInTiles false)
+ 	(inboardScrollbars true)
+ 	(infiniteUndo false)
+ 	(keepTickingWhilePainting false)
+ 	(logDebuggerStackToFile true)
+ 	(menuButtonInToolPane false)
+ 	(menuColorFromWorld false)
+ 	(menuWithIcons true)
+ 	(morphicProgressStyle true)
+ 	(mouseOverForKeyboardFocus false)
+ 	(navigatorOnLeftEdge true)
+ 	(noviceMode false)
+ 	(okToReinitializeFlaps true)
+ 	(oliveHandleForScriptedObjects false)
+ 	(optionalButtons true)
+ 	(passwordsOnPublish false)
+ 	(personalizedWorldMenu true)
+ 	(postscriptStoredAsEPS false)
+ 	(printAlternateSyntax false)
+ 	(projectsSentToDisk false)
+ 	(projectZoom true)
+ 	(readDocumentAtStartup true)
+ 	(restartAlsoProceeds false)
+ 	(reverseWindowStagger true)
+ 	(rotationAndScaleHandlesInPaintBox false)
+ 	(scrollBarsNarrow false)
+ 	(scrollBarsOnRight true)
+ 	(scrollBarsWithoutMenuButton false)
+ 	(selectionsMayShrink true)
+ 	(selectiveHalos true)
+ 	(showAdvancedNavigatorButtons false)
+ 	(showBoundsInHalo false)
+ 	(showDeprecationWarnings false)
+ 	(showFlapsWhenPublishing false)
+ 	(showLinesInHierarchyViews true)
+ 	(showSharedFlaps true)
+ 	(signProjectFiles true)
+ 	(simpleMenus false)
+ 	(slideDismissalsToTrash true)
+ 	(smartUpdating true)
+ 	(soundsEnabled true)
+ 	(swapMouseButtons false)
+ 	(systemWindowEmbedOK false)
+ 	(tabAmongFields true)
+ 	(testRunnerShowAbstractClasses false)
+ 	(thoroughSenders true)
+ 	(tileTranslucentDrag true)
+ 	(timeStampsInMenuTitles true)
+ 	(translationWithBabel false)
+ 	(turnOffPowerManager false)
+ 	(twentyFourHourFileStamps true)
+ 	(twoSidedPoohTextures true)
+ 	(typeCheckingInTileScripting true)
+ 	(unifyNestedProgressBars true)
+ 	(uniTilesClassic true)
+ 	(universalTiles false)
+ 	(updateFromServerAtStartup false)
+ 	(updateSavesFile false)
+ 	(useButtonPropertiesToFire false)
+ 	(useFileList2 true)
+ 	(useSmartLabels false)
+ 	(useUndo true)
+ 	(useVectorVocabulary false)
+ 	(viewersInFlaps true)
+ 	(warnIfNoChangesFile false)
+ 	(warnIfNoSourcesFile false)
+ 	(warningForMacOSFileNameLength false)
+ 	(wordStyleCursorMovement true)
+ 
+ 	).
+ 
+ Preferences setPreference: #haloTheme toValue: #iconicHaloSpecifications.
+ !

Item was added:
+ ----- Method: Preferences class>>canRecordWhilePlaying (in category '*Etoys-Squeakland-standard queries') -----
+ canRecordWhilePlaying
+ 	^ self
+ 		valueOfFlag: #canRecordWhilePlaying
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>celesteHasStatusPane (in category '*Etoys-Squeakland-standard queries') -----
+ celesteHasStatusPane
+ 	^ self
+ 		valueOfFlag: #celesteHasStatusPane
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>celesteShowsAttachmentsFlag (in category '*Etoys-Squeakland-standard queries') -----
+ celesteShowsAttachmentsFlag
+ 	^ self
+ 		valueOfFlag: #celesteShowsAttachmentsFlag
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>chicago (in category '*Etoys-Squeakland-themes') -----
+ chicago
+ 	"A theme for Squeakland developers"
+ 	"Preferences chicago"
+ 
+ 	self cambridge.
+ 	
+ 	self setPreferencesFrom: #(
+ 		(eToyFriendly false)
+ 		(showSecurityStatus true)
+ 	).!

Item was added:
+ ----- Method: Preferences class>>chooseButtonFont (in category '*Etoys-Squeakland-fonts') -----
+ chooseButtonFont
+ 	"Allow the user to select the font to use on buttons."
+ 
+ 	self chooseFontWithPrompt:  'Select the font to be
+ used for buttons' translated andSendTo: self withSelector: #setButtonFontTo: highlight: self standardButtonFont !

Item was added:
+ ----- Method: Preferences class>>chooseEToysButtonFont (in category '*Etoys-Squeakland-fonts') -----
+ chooseEToysButtonFont
+ 	"present a menu with the possible fonts for the eToys buttons"
+ 
+ 	self
+ 		chooseFontWithPrompt: 'Choose the etoy button font' translated
+ 		andSendTo: self
+ 		withSelector: #setEToysButtonFontTo:
+ 		highlight: self standardEToysButtonFont!

Item was added:
+ ----- Method: Preferences class>>chooseEToysCodeFont (in category '*Etoys-Squeakland-fonts') -----
+ chooseEToysCodeFont
+ 	"present a menu with the possible fonts for etoy textual code"
+ 
+ 	self
+ 		chooseFontWithPrompt: 'Choose the etoy code font' translated
+ 		andSendTo: self
+ 		withSelector: #setEToysCodeFontTo:
+ 		highlight: self standardEToysCodeFont!

Item was added:
+ ----- Method: Preferences class>>classicNewMorphMenu (in category '*Etoys-Squeakland-standard queries') -----
+ classicNewMorphMenu
+ 	^ self
+ 		valueOfFlag: #classicNewMorphMenu
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>clickOnLabelToEdit (in category '*Etoys-Squeakland-standard queries') -----
+ clickOnLabelToEdit
+ 	^ self
+ 		valueOfFlag: #clickOnLabelToEdit
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>colorWhenPrettyPrinting (in category '*Etoys-Squeakland-standard queries') -----
+ colorWhenPrettyPrinting
+ 	^ self
+ 		valueOfFlag: #colorWhenPrettyPrinting
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>compileAccessMethodForPreference: (in category '*Etoys-Squeakland-initialization') -----
+ compileAccessMethodForPreference: aPreference
+ 	"Compile an accessor method for the given preference"
+ 
+ 	self class 
+ 		compileSilently: (
+ 			'{1} ^self valueOfFlag: {2} ifAbsent: [ {3} ]'
+ 				format: {
+ 					aPreference name asString.
+ 					aPreference name asSymbol printString.
+ 					aPreference defaultValue storeString }) 
+ 		classified: '*autogenerated - standard queries'!

Item was added:
+ ----- Method: Preferences class>>compileHardCodedPref:enable: (in category '*Etoys-Squeakland-personalization') -----
+ compileHardCodedPref: prefName enable: aBoolean
+ 	"Compile a method that returns a simple true or false (depending on the value of aBoolean) when Preferences is sent prefName as a message"
+ 
+ 	self class 
+ 		compileSilently: (
+ 			'{1} ^{2}'
+ 				format: {
+ 					prefName asString.
+ 					aBoolean storeString })
+ 		classified: '*autogenerated - hard-coded prefs'.
+ 	
+ "Preferences compileHardCodedPref: #testing enable: false"!

Item was added:
+ ----- Method: Preferences class>>cpuWatcherEnabled (in category '*Etoys-Squeakland-standard queries') -----
+ cpuWatcherEnabled
+ 	^ self
+ 		valueOfFlag: #cpuWatcherEnabled
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>debugging (in category '*Etoys-Squeakland-standard queries') -----
+ debugging
+ 	^ self
+ 		valueOfFlag: #debugging
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>deletePersistedPreferences (in category '*Etoys-Squeakland-persistence') -----
+ deletePersistedPreferences
+ 	| d files |
+ 	self ensurePersistedPreferencesAccessible
+ 		ifFalse: [^self].
+ 	d := ExternalSettings preferenceDirectory ifNil: [^self].
+ 	files := d fileNamesMatching: '*', self persistedFileNameExtension.
+ 	files size = 0 ifTrue: [^self].
+ 	(self confirm: ('This will remove {1} stored preferences.
+ Are you sure?' translated format: {files size}))
+ 		ifTrue: [files do: [:f | d deleteFileNamed: f]].!

Item was added:
+ ----- Method: Preferences class>>dismissEventTheatreUponPublish (in category '*Etoys-Squeakland-standard queries') -----
+ dismissEventTheatreUponPublish
+ 	^ self
+ 		valueOfFlag: #dismissEventTheatreUponPublish
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>eToysCodeFont (in category '*Etoys-Squeakland-fonts') -----
+ eToysCodeFont
+ 	"Answer the font to use in the etoy environment to view textual code."
+ 
+ 	^ Parameters at: #eToysCodeFont ifAbsentPut: self standardEToysFont!

Item was added:
+ ----- Method: Preferences class>>enableInternetConfig (in category '*Etoys-Squeakland-standard queries') -----
+ enableInternetConfig
+ 	^ self
+ 		valueOfFlag: #enableInternetConfig
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>ensurePersistedPreferencesAccessible (in category '*Etoys-Squeakland-persistence') -----
+ ensurePersistedPreferencesAccessible
+ 	self persistedPreferencesAccessible
+ 		ifTrue: [^true].
+ 	self inform: ('{1} is in secure mode.
+ You cannot access the persistent preferences now.
+ To change them, start {1} without loading a project.' translated
+ 	format: {SystemVersion current baseName capitalized}).
+ 	^false!

Item was added:
+ ----- Method: Preferences class>>escapeKeyProducesMenu (in category '*Etoys-Squeakland-standard queries') -----
+ escapeKeyProducesMenu
+ 	^ self
+ 		valueOfFlag: #escapeKeyProducesMenu
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>fetchExternalSettingsIn: (in category '*Etoys-Squeakland-persistence') -----
+ fetchExternalSettingsIn: aDirectory
+ 	"Load persisted preferences"
+ 	"Preferences fetchExternalSettingsIn: ExternalSettings preferenceDirectory"
+ 
+ 	^ (aDirectory fileNamesMatching: '*', self persistedFileNameExtension)
+ 			do: [:fileName |
+ 				| pref value |
+ 				pref := fileName allButLast: self persistedFileNameExtension size.
+ 				value := self persistedValueFor: pref in: aDirectory.
+ 				(value isKindOf: Boolean) ifTrue:
+ 					[self enableOrDisable: pref asSymbol asPer: value]]!

Item was added:
+ ----- Method: Preferences class>>gradientMenu (in category '*Etoys-Squeakland-standard queries') -----
+ gradientMenu
+ 	^ self
+ 		valueOfFlag: #gradientMenu
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>gradientScrollBars (in category '*Etoys-Squeakland-standard queries') -----
+ gradientScrollBars
+ 	^ self
+ 		valueOfFlag: #gradientScrollBars
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>ignoreStyleIfOnlyBold (in category '*Etoys-Squeakland-standard queries') -----
+ ignoreStyleIfOnlyBold
+ 	^ self
+ 		valueOfFlag: #ignoreStyleIfOnlyBold
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>implicitSelfInTiles (in category '*Etoys-Squeakland-standard queries') -----
+ implicitSelfInTiles
+ 	^ self
+ 		valueOfFlag: #implicitSelfInTiles
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>inboardScrollbars (in category '*Etoys-Squeakland-standard queries') -----
+ inboardScrollbars
+ 	^ self
+ 		valueOfFlag: #inboardScrollbars
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>initializePreferencePanel:in: (in category '*Etoys-Squeakland-preferences panel') -----
+ initializePreferencePanel: aPanel in: aPasteUpMorph
+ 	"Initialize the given Preferences panel. in the given pasteup, which is the top-level panel installed in the container window.  Also used to reset it after some change requires reformulation"
+ 
+ 	| tabbedPalette controlPage aColor aFont maxEntriesPerCategory tabsMorph anExtent  prefObjects cc |
+ 	aPasteUpMorph removeAllMorphs.
+ 
+ 	aFont := Preferences standardListFont.
+ 	aColor := aPanel defaultBackgroundColor.
+ 	tabbedPalette := TabbedPalette newSticky.
+ 	tabbedPalette dropEnabled: false.
+ 	(tabsMorph := tabbedPalette tabsMorph) color: aColor darker;
+ 		 highlightColor: Color red regularColor: Color brown darker darker.
+ 	tabbedPalette on: #mouseDown send: #yourself to: #().
+ 	maxEntriesPerCategory := 0.
+ 	self listOfCategories do: 
+ 		[:aCat | 
+ 			controlPage := AlignmentMorph newColumn beSticky color: aColor.
+ 			controlPage on: #mouseDown send: #yourself to: #().
+ 			controlPage dropEnabled: false.
+ 			Preferences alternativeWindowLook ifTrue:
+ 				[cc := Color transparent.
+ 				controlPage color: cc].
+ 			controlPage borderColor: aColor;
+ 				 layoutInset: 4.
+ 			(prefObjects := self preferenceObjectsInCategory: aCat) do:
+ 				[:aPreference | | button |
+ 					button _ aPreference representativeButtonWithColor: cc inPanel: aPanel.
+ 					button ifNotNil: [controlPage addMorphBack: button]].
+ 			controlPage setNameTo: aCat asString.
+ 			aCat = #?
+ 				ifTrue:	[aPanel addHelpItemsTo: controlPage].
+ 			tabbedPalette addTabFor: controlPage font: aFont.
+ 			aCat = 'search results' ifTrue:
+ 				[(tabbedPalette tabNamed: aCat) setBalloonText:
+ 					'Use the ? category to find preferences by keyword; the results of your search will show up here' translated].
+ 		maxEntriesPerCategory := maxEntriesPerCategory max: prefObjects size].
+ 	tabbedPalette selectTabNamed: '?'.
+ 	tabsMorph rowsNoWiderThan: aPasteUpMorph width.
+ 	aPasteUpMorph on: #mouseDown send: #yourself to: #().
+ 	anExtent := aPasteUpMorph width @ (490 max: (25 + tabsMorph height + (24 * maxEntriesPerCategory))).
+ 	aPasteUpMorph extent: anExtent.
+ 	aPasteUpMorph color: aColor.
+ 	aPasteUpMorph 	 addMorphBack: tabbedPalette.!

Item was added:
+ ----- Method: Preferences class>>logDebuggerStackToConsole (in category '*Etoys-Squeakland-standard queries') -----
+ logDebuggerStackToConsole
+ 	^ self
+ 		valueOfFlag: #logDebuggerStackToConsole
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>monticelloToolWindowColor (in category '*Etoys-Squeakland-standard queries') -----
+ monticelloToolWindowColor
+ 	^ self
+ 		valueOfFlag: #monticelloToolWindowColor
+ 		ifAbsent: [Color
+ 				r: 0.627
+ 				g: 0.69
+ 				b: 0.976]!

Item was added:
+ ----- Method: Preferences class>>morphicProgressStyle (in category '*Etoys-Squeakland-standard queries') -----
+ morphicProgressStyle
+ 	^ self
+ 		valueOfFlag: #morphicProgressStyle
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>openNewPreferencesPanel (in category '*Etoys-Squeakland-preferences panel') -----
+ openNewPreferencesPanel
+ 	"Create and open a new Preferences Panel"
+ 
+ 	| window |
+ 	window := self preferencesControlPanel.
+ 	self currentWorld addMorphFront: window.
+ 	window center: self currentWorld center.
+ 	window activateAndForceLabelToShow.
+ 
+ "Preferences openNewPreferencesPanel"!

Item was added:
+ ----- Method: Preferences class>>persistValue:for: (in category '*Etoys-Squeakland-persistence') -----
+ persistValue: aBooleanOrNil for: aSymbol
+ 	"Save the preference aSymbol on file, so it can be restored to the given value on startup. If nil, delete persistent value."
+ 
+ 	| fileName file |
+ 	fileName := self persistedFileNameFor: aSymbol.
+ 	aBooleanOrNil ifNil: [
+ 		^ExternalSettings preferenceDirectory ifNotNilDo: [:fd |
+ 			fd deleteFileNamed: fileName ifAbsent: []]].
+ 	file := ExternalSettings assuredPreferenceDirectory
+ 		forceNewFileNamed: fileName.
+ 	[file
+ 		wantsLineEndConversion: true;
+ 		nextPutAll: 'value: '; print: aBooleanOrNil; cr.
+ 	]	ensure: [file close]!

Item was added:
+ ----- Method: Preferences class>>persistedFileNameExtension (in category '*Etoys-Squeakland-persistence') -----
+ persistedFileNameExtension
+ 	^'.pref'!

Item was added:
+ ----- Method: Preferences class>>persistedFileNameFor: (in category '*Etoys-Squeakland-persistence') -----
+ persistedFileNameFor: aSymbol
+ 	^aSymbol, self persistedFileNameExtension!

Item was added:
+ ----- Method: Preferences class>>persistedPreferencesAccessible (in category '*Etoys-Squeakland-persistence') -----
+ persistedPreferencesAccessible
+ 	^SecurityManager default hasFileAccess
+ !

Item was added:
+ ----- Method: Preferences class>>persistedValueFor: (in category '*Etoys-Squeakland-persistence') -----
+ persistedValueFor: aSymbol
+ 	^self persistedValueFor: aSymbol in: ExternalSettings preferenceDirectory!

Item was added:
+ ----- Method: Preferences class>>persistedValueFor:in: (in category '*Etoys-Squeakland-persistence') -----
+ persistedValueFor: aSymbol in: aDirectory
+ 	"Read the value of preference aSymbol from file. Answer nil if not found."
+ 
+ 	| tokens value f |
+ 	aDirectory ifNil: [^nil].
+ 	f := (aDirectory oldFileOrNoneNamed: (self persistedFileNameFor: aSymbol)) ifNil: [^nil].
+ 	[
+ 		f wantsLineEndConversion: true.
+ 		f contentsOfEntireFile linesDo: [:line |
+ 			tokens := line findTokens: ' 	:' keep: ':'.
+ 			(tokens size = 3 and: [tokens second = ':']) ifTrue: [
+ 				tokens first caseOf: { 
+ 					['value'] -> [tokens third caseOf: {
+ 						['true'] -> [value := true].
+ 						['false'] -> [value := false].
+ 					} otherwise: []].
+ 				} otherwise: []]].
+ 	] ensure: [f close].
+ 	^value!

Item was added:
+ ----- Method: Preferences class>>preferencesControlPanel (in category '*Etoys-Squeakland-preferences panel') -----
+ preferencesControlPanel
+ 	"Answer a Preferences control panel window"
+ 
+ 	"Preferences preferencesControlPanel openInHand"
+ 	| window playfield aPanel |
+ 
+ 	aPanel _ PreferencesPanel new.
+ 	playfield _ PasteUpMorph new width: 450.
+ 	playfield dropEnabled: false.
+ 	window _ (SystemWindow labelled: 'Preferences' translated) model: aPanel.
+ 	self initializePreferencePanel: aPanel in: playfield.
+ 	window on: #keyStroke send: #keyStroke: to: aPanel.
+ 	window bounds: (100 @ 100 - (0 @ window labelHeight + window borderWidth) extent: playfield extent + (2 * window borderWidth)).
+ 	window addMorph: playfield frame: (0 @ 0 extent: 1 @ 1).
+ 	window updatePaneColors.
+ 	window setProperty: #minimumExtent toValue: playfield extent + (12 at 15).
+ 	^ window!

Item was added:
+ ----- Method: Preferences class>>preserveTrash (in category '*Etoys-Squeakland-standard queries') -----
+ preserveTrash
+ 	^ self
+ 		valueOfFlag: #preserveTrash
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>printAlternateSyntax (in category '*Etoys-Squeakland-standard queries') -----
+ printAlternateSyntax
+ 	^ self
+ 		valueOfFlag: #printAlternateSyntax
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>projectNameInTitle (in category '*Etoys-Squeakland-standard queries') -----
+ projectNameInTitle
+ 	^ self
+ 		valueOfFlag: #projectNameInTitle
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>promptForUpdateServer (in category '*Etoys-Squeakland-standard queries') -----
+ promptForUpdateServer
+ 	^ self
+ 		valueOfFlag: #promptForUpdateServer
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>rebuildFontConfigurationMenu: (in category '*Etoys-Squeakland-fonts') -----
+ rebuildFontConfigurationMenu: aMenu
+ 	"Rebuild the font-configuration menu."
+ 
+ 	aMenu addTitle: 'Standard System Fonts' translated.
+ 	
+ 	aMenu addStayUpIcons.
+ 	
+ 	aMenu add: 'default text font...' translated action: #chooseSystemFont.
+ 	aMenu balloonTextForLastItem: 'Choose the default font to be used for code and  in workspaces, transcripts, etc.' translated.
+ 	aMenu lastItem font: Preferences standardDefaultTextFont.
+ 	
+ 	aMenu add: 'list font...' translated action: #chooseListFont.
+ 	aMenu lastItem font: Preferences standardListFont.
+ 	aMenu balloonTextForLastItem: 'Choose the font to be used in list panes' translated.
+ 	
+ 	aMenu add: 'flaps font...' translated action: #chooseFlapsFont.
+ 	aMenu lastItem font: Preferences standardFlapFont.
+ 	aMenu balloonTextForLastItem: 'Choose the font to be used on textual flap tabs' translated.
+ 
+ 	aMenu add: 'etoy tile font...' translated action: #chooseEToysFont.
+ 	aMenu lastItem font: Preferences standardEToysFont.
+ 	aMenu balloonTextForLastItem: 'Choose the font to be used on etoy tiles' translated.
+ 
+ 	aMenu add: 'etoy button font...' translated action: #chooseEToysButtonFont.
+ 	aMenu lastItem font: Preferences standardEToysButtonFont.
+ 	aMenu balloonTextForLastItem: 'Choose the font to be used on etoy buttons' translated.
+ 
+ 	aMenu add: 'etoy code font...' translated action: #chooseEToysCodeFont.
+ 	aMenu lastItem font: Preferences standardEToysCodeFont.
+ 	aMenu balloonTextForLastItem: 'Choose the font to be used for textual code in etoys' translated.
+ 
+ 	aMenu add: 'etoy title font...' translated action: #chooseEToysTitleFont.
+ 	aMenu lastItem font: Preferences standardEToysTitleFont.
+ 	aMenu balloonTextForLastItem: 'Choose the font to be used titles in etoys' translated.
+ 
+ "	aMenu add: 'halo label font...' translated action: #chooseHaloLabelFont.
+ 	aMenu lastItem font: Preferences standardHaloLabelFont.
+ 	aMenu balloonTextForLastItem: 'Choose the font to be used on labels in halo' translated.
+ 
+ 	aMenu add: 'object name font...' translated action: #chooseObjectNameFont.
+ 	aMenu lastItem font: Preferences standardObjectNameFont.
+ 	aMenu balloonTextForLastItem: 'Choose the font to be used for object names' translated."
+ 
+ 	aMenu add: 'menu font...' translated action: #chooseMenuFont.
+ 	aMenu lastItem font: Preferences standardMenuFont.
+ 	aMenu balloonTextForLastItem: 'Choose the font to be used in menus' translated.
+ 	
+ 	aMenu add: 'window-title font...' translated action: #chooseWindowTitleFont.
+ 	aMenu lastItem font: Preferences windowTitleFont emphasis: 1.
+ 	aMenu balloonTextForLastItem: 'Choose the font to be used in window titles.' translated.
+ 
+ 	aMenu add: 'balloon-help font...' translated action: #chooseBalloonHelpFont.
+ 	aMenu lastItem font: Preferences standardBalloonHelpFont.
+ 	aMenu balloonTextForLastItem: 'choose the font to be used when presenting balloon help.' translated.
+ 	
+ 	aMenu add: 'button font...' translated action: #chooseButtonFont. 
+ 	aMenu lastItem font: Preferences standardButtonFont. 
+ 	aMenu balloonTextForLastItem: 'Choose the font to be used for (some) buttons.' translated.
+ 	
+ 	aMenu add: 'code font...' translated action: #chooseCodeFont. 
+ 	aMenu lastItem font: Preferences standardCodeFont. 
+ 	aMenu balloonTextForLastItem: 'Choose the font to be used in code panes.' translated.
+ 	
+ 	aMenu add: 'connector label font...' translated action: #chooseConnectorsLabelFont. 
+ 	aMenu lastItem font: Preferences connectorsLabelFont. 
+ 	aMenu balloonTextForLastItem: 'Choose the font to be used in connector labels.' translated.
+ 
+ 	aMenu addLine.
+ 	aMenu add: 'restore default font choices' translated action: #restoreDefaultFonts.
+ 	aMenu balloonTextForLastItem: 'Use the standard system font defaults' translated.
+ 	
+ 	aMenu add: 'show current font choices' translated action: #printStandardSystemFonts.
+ 	aMenu balloonTextForLastItem: 'Open a window showing the current font settings' translated.
+ 
+ 	aMenu addLine.
+ 	aMenu add: 'refresh this menu' translated target: aMenu action: #updateMenu.
+ 	aMenu balloonTextForLastItem: 'If any font settings have changed since you pinned this menu up, this will allow the menu to rebuilt to reflect current font choices.' translated.
+ 
+ 	^ aMenu!

Item was added:
+ ----- Method: Preferences class>>registerInFlapsRegistry (in category '*Etoys-Squeakland-class initialization') -----
+ registerInFlapsRegistry
+ 	"Register the receiver in the system's flaps registry"
+ 	self environment
+ 		at: #Flaps
+ 		ifPresent: [:cl | cl registerQuad: {#Preferences. #preferencesControlPanel.	'Preferences' translatedNoop.	'Allows you to control numerous options' translatedNoop}
+ 						forFlapNamed: 'Tools'.
+ 						cl registerQuad: {#Preferences. #annotationEditingWindow.	'Annotations' translatedNoop.		'Allows you to specify the annotations to be shown in the annotation panes of browsers, etc.' translatedNoop}
+ 						forFlapNamed: 'Tools'.]!

Item was added:
+ ----- Method: Preferences class>>registeredPreferencesFileSuffixes (in category '*Etoys-Squeakland-services') -----
+ registeredPreferencesFileSuffixes
+ 	^{'prefs'}!

Item was added:
+ ----- Method: Preferences class>>restoreDefaultEToysFonts (in category '*Etoys-Squeakland-prefs - fonts') -----
+ restoreDefaultEToysFonts
+ 	"Since this is called from menus, we can take the opportunity to
+ 	prompt for missing font styles."
+ 	"
+ 	Preferences restoreDefaultEToysFonts
+ 	"
+ 	Preferences setDefaultFonts: #(#(#setListFontTo: #BitstreamVeraSans 15 ) #(#setFlapsFontTo: #BitstreamVeraSansBold 15 ) #(#setEToysButtonFontTo: #BitstreamVeraSans 15 ) #(#setEToysFontTo: #BitstreamVeraSansBold 15 ) #(#setEToysCodeFontTo: #BitstreamVeraSans 15 ) #(#setEToysTitleFontTo: #BitstreamVeraSans 32 ) #(#setPaintBoxButtonFontTo: #BitstreamVeraSans 9 ) #(#setMenuFontTo: #BitstreamVeraSans 15 ) #(#setWindowTitleFontTo: #BitstreamVeraSans 15 ) #(#setBalloonHelpFontTo: #BitstreamVeraSans 15 ) #(#setConnectorsLabelFontTo: #BitstreamVeraSans 15 ) )!

Item was added:
+ ----- Method: Preferences class>>restoreDefaultFontsForSqueakland (in category '*Etoys-Squeakland-fonts') -----
+ restoreDefaultFontsForSqueakland
+ 	"Since this is called from menus, we can take the opportunity to prompt for missing font styles."
+ 	"
+ 	Preferences restoreDefaultFontsForSqueakland
+ 	"
+ 
+ 	Preferences restoreDefaultFonts.
+ 	Preferences setDefaultFonts: #(
+ 			(setCodeFontTo: 	BitstreamVeraSans 				15)
+ 			(setSystemFontTo: BitstreamVeraSans 				15)
+ 		).
+ 
+ !

Item was added:
+ ----- Method: Preferences class>>rotationAndScaleHandlesInPaintBox (in category '*Etoys-Squeakland-standard queries') -----
+ rotationAndScaleHandlesInPaintBox
+ 	^ self
+ 		valueOfFlag: #rotationAndScaleHandlesInPaintBox
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>roundedMenuCorners (in category '*Etoys-Squeakland-standard queries') -----
+ roundedMenuCorners
+ 	^ self
+ 		valueOfFlag: #roundedMenuCorners
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>roundedWindowCorners (in category '*Etoys-Squeakland-standard queries') -----
+ roundedWindowCorners
+ 	^ self
+ 		valueOfFlag: #roundedWindowCorners
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>scrollBarsWithoutMenuButton (in category '*Etoys-Squeakland-standard queries') -----
+ scrollBarsWithoutMenuButton
+ 	^ self
+ 		valueOfFlag: #scrollBarsWithoutMenuButton
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>selectionsMayShrink (in category '*Etoys-Squeakland-standard queries') -----
+ selectionsMayShrink
+ 	^ self
+ 		valueOfFlag: #selectionsMayShrink
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>serviceLoadPreferences (in category '*Etoys-Squeakland-services') -----
+ serviceLoadPreferences 
+ 	"Answer a service for loading preferences from disk"
+ 
+ 	^ SimpleServiceEntry 
+ 		provider: self 
+ 		label: 'load preferences' translatedNoop
+ 		selector: #restorePreferencesFromDisk:
+ 		description: 'load preferences file from disk' translatedNoop
+ 		buttonLabel: 'load preferences' translatedNoop!

Item was added:
+ ----- Method: Preferences class>>setEToysButtonFontTo: (in category '*Etoys-Squeakland-fonts') -----
+ setEToysButtonFontTo: aFont
+ 	"change the font used on buttons in the eToys environment"
+ 
+ 	Parameters at: #eToysButtonFont put: aFont!

Item was added:
+ ----- Method: Preferences class>>setEToysCodeFontTo: (in category '*Etoys-Squeakland-fonts') -----
+ setEToysCodeFontTo: aFont 
+ 	"change the code font used in eToys environment"
+ 
+ 	Parameters at: #eToysCodeFont put: aFont!

Item was added:
+ ----- Method: Preferences class>>showDeprecationWarnings (in category '*Etoys-Squeakland-standard queries') -----
+ showDeprecationWarnings
+ 	^ self
+ 		valueOfFlag: #showDeprecationWarnings
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>showLinesInHierarchyViews (in category '*Etoys-Squeakland-standard queries') -----
+ showLinesInHierarchyViews
+ 	^ self
+ 		valueOfFlag: #showLinesInHierarchyViews
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>slideDismissalsToTrash (in category '*Etoys-Squeakland-standard queries') -----
+ slideDismissalsToTrash
+ 	^ self
+ 		valueOfFlag: #slideDismissalsToTrash
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>soundQuickStart (in category '*Etoys-Squeakland-standard queries') -----
+ soundQuickStart
+ 	^ self
+ 		valueOfFlag: #soundQuickStart
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>soundStopWhenDone (in category '*Etoys-Squeakland-standard queries') -----
+ soundStopWhenDone
+ 	^ self
+ 		valueOfFlag: #soundStopWhenDone
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>soundsEnabled (in category '*Etoys-Squeakland-standard queries') -----
+ soundsEnabled
+ 	^ self
+ 		valueOfFlag: #soundsEnabled
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>standardEToysButtonFont (in category '*Etoys-Squeakland-fonts') -----
+ standardEToysButtonFont
+ 	"Answer the font to be used on buttons in the eToys environment"
+ 
+ 	^ Parameters at: #eToysButtonFont ifAbsentPut: [self standardButtonFont]!

Item was added:
+ ----- Method: Preferences class>>standardEToysCodeFont (in category '*Etoys-Squeakland-fonts') -----
+ standardEToysCodeFont
+ 	"Answer the font to be used for textual code in the eToys environment"
+ 
+ 	^ Parameters at: #eToysCodeFont  ifAbsentPut: [self standardEToysFont]!

Item was added:
+ ----- Method: Preferences class>>testRunnerShowAbstractClasses (in category '*Etoys-Squeakland-standard queries') -----
+ testRunnerShowAbstractClasses
+ 	^ self
+ 		valueOfFlag: #testRunnerShowAbstractClasses
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>twoSidedPoohTextures (in category '*Etoys-Squeakland-standard queries') -----
+ twoSidedPoohTextures
+ 	^ self
+ 		valueOfFlag: #twoSidedPoohTextures
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>unifyNestedProgressBars (in category '*Etoys-Squeakland-standard queries') -----
+ unifyNestedProgressBars
+ 	^ self
+ 		valueOfFlag: #unifyNestedProgressBars
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>updateFromServerAtStartup (in category '*Etoys-Squeakland-standard queries') -----
+ updateFromServerAtStartup
+ 	^ self
+ 		valueOfFlag: #updateFromServerAtStartup
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>updateSavesFile (in category '*Etoys-Squeakland-standard queries') -----
+ updateSavesFile
+ 	^ self
+ 		valueOfFlag: #updateSavesFile
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>upgradeIsMerge (in category '*Etoys-Squeakland-standard queries') -----
+ upgradeIsMerge
+ 	^ self
+ 		valueOfFlag: #upgradeIsMerge
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>useArtificialSweetenerBar (in category '*Etoys-Squeakland-standard queries') -----
+ useArtificialSweetenerBar
+ 	^ self
+ 		valueOfFlag: #useArtificialSweetenerBar
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>useBiggerPaintingBox (in category '*Etoys-Squeakland-standard queries') -----
+ useBiggerPaintingBox
+ 	^ self
+ 		valueOfFlag: #useBiggerPaintingBox
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>useFileList2 (in category '*Etoys-Squeakland-standard queries') -----
+ useFileList2
+ 	^ self
+ 		valueOfFlag: #useFileList2
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>usePangoRenderer (in category '*Etoys-Squeakland-standard queries') -----
+ usePangoRenderer
+ 	^ self
+ 		valueOfFlag: #usePangoRenderer
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>usePopUpArrows (in category '*Etoys-Squeakland-standard queries') -----
+ usePopUpArrows
+ 	^ self
+ 		valueOfFlag: #usePopUpArrows
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>warnIfChangesFileReadOnly (in category '*Etoys-Squeakland-standard queries') -----
+ warnIfChangesFileReadOnly
+ 	^ self
+ 		valueOfFlag: #warnIfChangesFileReadOnly
+ 		ifAbsent: [true]!

Item was added:
+ ----- Method: Preferences class>>warningForMacOSFileNameLength (in category '*Etoys-Squeakland-standard queries') -----
+ warningForMacOSFileNameLength
+ 	^ self
+ 		valueOfFlag: #warningForMacOSFileNameLength
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: Preferences class>>windowColorHelp (in category '*Etoys-Squeakland-window colors') -----
+ windowColorHelp
+ 	"Provide help for the window-color panel"
+ 
+ 	| helpString |
+ 	helpString _ 
+ 'The "Window Colors" panel lets you select colors for many kinds of standard Squeak windows.
+ 
+ You can change your color preference for any particular tool by clicking on the color swatch and then selecting the desired color from the resulting color-picker.
+ 
+ The three buttons entitled "Bright", "Pastel", and "White" let you revert to any of three different standard color schemes.  
+ 
+ The choices you make in the Window Colors panel only affect the colors of new windows that you open.
+ 
+ You can make other tools have their colors governed by this panel by simply implementing #windowColorSpecification on the class side of the model -- consult implementors of that method to see examples of how to do this.'.
+ 
+ 	 (StringHolder new contents: helpString)
+ 		openLabel: 'About Window Colors' translated
+ 
+ 	"Preferences windowColorHelp"!

Item was added:
+ ----- Method: Preferences class>>windowSpecificationPanel (in category '*Etoys-Squeakland-window colors') -----
+ windowSpecificationPanel
+ 	"Put up a panel for specifying window colors"
+ 
+ 	"Preferences windowSpecificationPanel"
+ 	| aPanel buttonRow aButton aRow aSwatch aColor aWindow aMiniWorld aStringMorph |
+ 	aPanel _ AlignmentMorph newColumn hResizing: #shrinkWrap; vResizing: #shrinkWrap;
+ 		layoutInset: 0.
+ 
+ 	aPanel addMorph: (buttonRow _ AlignmentMorph newRow color: (aColor _ Color tan lighter)).
+ 	
+ 	buttonRow addTransparentSpacerOfSize: 2 at 0.
+ 	buttonRow addMorphBack: (SimpleButtonMorph new label: '?'; target: self; actionSelector: #windowColorHelp; setBalloonText: 'Click for an explanation of this panel' translated; color: Color veryVeryLightGray; yourself).
+ 	buttonRow addTransparentSpacerOfSize: 8 at 0.
+ 	#(	('Bright' 	installBrightWindowColors	yellow
+ 					'Use standard bright colors for all windows.')
+ 		('Pastel'		installPastelWindowColors	paleMagenta
+ 					'Use standard pastel colors for all windows.')
+ 		('White'	installUniformWindowColors		white
+ 					'Use white backgrounds for all standard windows.')) translatedNoop do:
+ 
+ 		[:quad |
+ 			aButton _ (SimpleButtonMorph new target: self)
+ 				label: quad first translated;
+ 				actionSelector: quad second;
+ 				color: (Color colorFrom: quad third);
+ 				setBalloonText: quad fourth translated;
+ 				yourself.
+ 			buttonRow addMorphBack: aButton.
+ 			buttonRow addTransparentSpacerOfSize: 10 at 0].
+ 
+ 	self windowColorTable do:
+ 		[:colorSpec | 
+ 			aRow _ AlignmentMorph newRow color: aColor.
+ 			aSwatch _ ColorSwatch new
+ 				target: self;
+ 				getSelector: #windowColorFor:;
+ 				putSelector: #setWindowColorFor:to:;
+ 				argument: colorSpec classSymbol;
+ 				extent: (40 @ 20);
+ 				setBalloonText: ('Click here to change the standard color to be used for {1} windows.' format: {colorSpec wording translated});
+ 				yourself.
+ 			aRow addMorphFront: aSwatch.
+ 			aRow addTransparentSpacerOfSize: (12 @ 1).
+ 			aRow addMorphBack: (aStringMorph _ StringMorph contents: colorSpec wording translated font: TextStyle defaultFont).
+ 			aStringMorph setBalloonText: colorSpec helpMessage translated.
+ 			aPanel addMorphBack: aRow].
+ 
+ 	 Smalltalk isMorphic
+                 ifTrue:
+                         [aWindow _ aPanel wrappedInWindowWithTitle: 'Window Colors' translated.
+ 					" don't allow the window to be picked up by clicking inside "
+ 					aPanel on: #mouseDown send: #yourself to: aPanel.
+ 					self currentWorld addMorphCentered: aWindow.
+ 					aWindow activateAndForceLabelToShow ]
+                 ifFalse:
+                         [(aMiniWorld _ MVCWiWPasteUpMorph newWorldForProject: nil)
+ 						addMorph: aPanel.
+                            aMiniWorld startSteppingSubmorphsOf: aPanel.
+                         MorphWorldView openOn: aMiniWorld
+                                 label: 'Window Colors' translated
+                                 extent: aMiniWorld fullBounds extent]!

Item was added:
+ Model subclass: #PreferencesPanel
+ 	instanceVariableNames: 'searchString'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Support'!
+ 
+ !PreferencesPanel commentStamp: '<historical>' prior: 0!
+ I represent a the model of a Preferences window.!

Item was added:
+ ----- Method: PreferencesPanel class>>deleteAllPreferencesPanels (in category 'cleanup') -----
+ deleteAllPreferencesPanels
+ 	"Called manually to clobber all existing preferences panels"
+ 	"PreferencesPanel deleteAllPreferencesPanels"
+ 
+ 	| aWindow |
+ 	self allInstancesDo:
+ 		[:aPanel |
+ 			(aWindow _ aPanel containingWindow) isMorph
+ 				ifTrue:
+ 					[aWindow delete]].
+ 	self killExistingMVCViews.
+ 	UpdatingThreePhaseButtonMorph allInstancesDo: "clobber old stand-alone prefs buttons"
+ 		[:m | (m actionSelector == #togglePreference:) ifTrue:
+ 			[(m owner isAlignmentMorph) ifTrue:
+ 				[m owner delete]]]!

Item was added:
+ ----- Method: PreferencesPanel class>>isAPreferenceViewToKill: (in category 'cleanup') -----
+ isAPreferenceViewToKill: aSystemView
+ 	"Answer whether the given StandardSystemView is one affiliated with a PreferencesPanel"
+ 
+ 	| m target subView |
+ 	aSystemView subViews size = 1 ifFalse: [^ false].
+ 	subView _ aSystemView subViews first.
+ 	(subView isKindOf: MorphWorldView) ifFalse: [^ false].
+ 	((m _ subView model) isKindOf: MVCWiWPasteUpMorph) ifFalse: [^ false].
+ 	m submorphs size = 1 ifFalse: [^ false].
+ 	m firstSubmorph submorphs size = 1 ifFalse: [^ false].
+ 	target _ m firstSubmorph firstSubmorph. 
+ 	(target isKindOf: TabbedPalette) ifFalse: [^ false].
+ 	^ #(browsing debug fileout general halos) allSatisfy: [:s |
+ 		(target tabNamed: s) notNil]!

Item was added:
+ ----- Method: PreferencesPanel class>>killExistingMVCViews (in category 'cleanup') -----
+ killExistingMVCViews
+ 	"Kill all existing preferences views in mvc"
+ "
+ PreferencesPanel killExistingMVCViews
+ "
+ 	| byebye |
+ 
+ 	ControlManager allInstances do: [ :cm |
+ 		byebye _ cm controllersSatisfying: [ :eachC |
+ 			self isAPreferenceViewToKill: eachC view].
+ 		byebye do: [ :each | 
+ 			each status: #closed.
+ 			each view release.
+ 			cm unschedule: each]]!

Item was added:
+ ----- Method: PreferencesPanel class>>windowColorSpecification (in category 'window color') -----
+ windowColorSpecification
+ 	"Answer a WindowColorSpec object that declares my preference"
+ 
+ 	^ WindowColorSpec classSymbol: self name wording: 'Preferences Panel' translatedNoop brightColor: #(0.645 1.0 1.0)	pastelColor: #(0.886 1.0 1.0) helpMessage: 'A tool for expressing personal preferences for numerous options.' translatedNoop!

Item was added:
+ ----- Method: PreferencesPanel>>addHelpItemsTo: (in category 'find') -----
+ addHelpItemsTo: panelPage
+ 	"Add the items appropriate the the ? page of the receiver"
+ 
+ 	| aButton aTextMorph aMorph firstTextMorph |
+ 	panelPage hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ 	firstTextMorph _  TextMorph new contents: 'Search Preferences for:' translated.
+ 	"firstTextMorph beAllFont: ((TextStyle default fontOfSize: 13) emphasized: 1)."
+ 	panelPage addMorphBack: firstTextMorph lock.
+ 	panelPage addTransparentSpacerOfSize: 0 at 10.
+ 
+ 	aMorph _ RectangleMorph new clipSubmorphs: true; beTransparent; borderWidth: 2; borderColor: Color black; extent: 250 @ 36.
+ 	aMorph vResizing: #rigid; hResizing: #rigid.
+ 	aTextMorph _  PluggableTextMorph new
+ 				on: self
+ 				text: #searchString
+ 				accept: #setSearchStringTo:
+ 				readSelection: nil
+ 				menu: nil.
+ "	aTextMorph hResizing: #rigid."
+ 	aTextMorph borderWidth: 0.
+ 	aTextMorph font: ((TextStyle default fontOfSize: 21) emphasized: 1); setTextColor: Color red.
+ 	aMorph addMorphBack: aTextMorph.
+ 	aTextMorph acceptOnCR: true.
+ 	aTextMorph position: (aTextMorph position + (6 at 5)).
+ 	aMorph clipLayoutCells: true.
+ 	aTextMorph extent: 240 @ 25.
+ 	panelPage addMorphBack: aMorph.
+ 	aTextMorph setBalloonText: 'Type what you want to search for here, then hit the "Search" button, or else hit RETURN or ENTER' translated.
+ 	aTextMorph setTextMorphToSelectAllOnMouseEnter.
+ 	aTextMorph hideScrollBarsIndefinitely.
+ 	panelPage addTransparentSpacerOfSize: 0 at 10.
+ 
+ 	aButton _ SimpleButtonMorph new 
+ 				target: self; 
+ 				color: Color transparent; 
+ 				actionSelector: #initiateSearch:;
+ 				 arguments: {aTextMorph};
+ 				 label: 'Search' translated.
+ 	panelPage addMorphBack: aButton.
+ 	aButton setBalloonText: 'Type what you want to search for in the box above, then click here (or hit RETURN or ENTER) to start the search; results will appear in the "search results" category.' translated.
+ 
+ 	panelPage addTransparentSpacerOfSize: 0 at 30.
+ 
+ 	panelPage addMorphBack: (SimpleButtonMorph new 
+ 								color: Color transparent;
+ 								 label: 'Reset preferences on startup' translated;
+ 								 target: Preferences;
+ 								 actionSelector: #deletePersistedPreferences;
+ 								 setBalloonText: 'Click here to delete all the preferences saved on file. On the next start, they will have their original value.' translated ; yourself).
+ 
+ 	panelPage addTransparentSpacerOfSize: 0 at 14.
+ 
+ Preferences eToyFriendly ifFalse: [ 
+ 	panelPage addMorphBack: (SimpleButtonMorph new 
+ 								color: Color transparent;
+ 								 label: 'Restore all Default Preference Settings' translated;
+ 								 target: Preferences;
+ 								 actionSelector: #chooseInitialSettings;
+ 								 setBalloonText: 'Click here to reset all the preferences to their standard default values.' translated ; yourself).
+ 
+ 	panelPage addTransparentSpacerOfSize: 0 at 14.
+ 	panelPage addMorphBack: (SimpleButtonMorph new 
+ 								color: Color transparent; 
+ 								label: 'Save Current Settings as my Personal Preferences' translated; 
+ 								target: Preferences;
+ 								 actionSelector: #savePersonalPreferences;
+ 								 setBalloonText: 'Click here to save the current constellation of Preferences settings as your personal defaults; you can get them all reinstalled with a single gesture by clicking the "Restore my Personal Preferences".' translated; yourself).
+ 
+ 	panelPage addTransparentSpacerOfSize: 0 at 14.
+ 	panelPage addMorphBack: (SimpleButtonMorph new 
+ 								color: Color transparent; 
+ 								label: 'Restore my Personal Preferences' translated;
+ 								 target: Preferences;
+ 								 actionSelector: #restorePersonalPreferences;
+ 								 setBalloonText: 'Click here to reset all the preferences to their values in your Personal Preferences.' translated; yourself).
+ 
+ 	panelPage addTransparentSpacerOfSize: 0 at 30.
+ 	panelPage addMorphBack: (SimpleButtonMorph new 
+ 								color: Color transparent; 
+ 								label: 'Save Current Settings to Disk' translated; 
+ 								target: Preferences; 
+ 								actionSelector: #storePreferencesToDisk;
+ 								setBalloonText: 'Click here to save the current constellation of Preferences settings to a file; you can get them all reinstalled with a single gesture by clicking "Restore Settings From Disk".' translated; yourself).
+ 
+ 	panelPage addTransparentSpacerOfSize: 0 at 14.
+ 	panelPage addMorphBack: (SimpleButtonMorph new 
+ 								color: Color transparent; 
+ 								label: 'Restore Settings from Disk' translated; 
+ 								target: Preferences; 
+ 								actionSelector: #restorePreferencesFromDisk; 
+ 								setBalloonText: 'Click here to load all the preferences from their saved values on disk.' translated; yourself).
+ 
+ 	panelPage addTransparentSpacerOfSize: 0 at 30.
+ 
+ 	panelPage addMorphBack: (SimpleButtonMorph new
+ 								color: Color transparent;
+ 								label: 'Inspect Parameters' translated; 
+ 								target: Preferences; 
+ 								actionSelector: #inspectParameters; 
+ 								setBalloonText: 'Click here to view all the values stored in the system Parameters dictionary' translated; yourself).
+ 	panelPage addTransparentSpacerOfSize: 0 at 10.
+ 	panelPage addMorphBack: (Preferences themeChoiceButtonOfColor: Color transparent font: TextStyle defaultFont).
+ 	panelPage addTransparentSpacerOfSize: 0 at 10.
+ ].
+ 
+ 	panelPage addMorphBack: (SimpleButtonMorph new 
+ 								color: Color transparent; 
+ 								label: 'Help!!' translated;
+ 								target: Preferences;
+ 								actionSelector: #giveHelpWithPreferences; 
+ 								setBalloonText: 'Click here to get some hints on use of this Preferences Panel' translated; yourself).
+ 	panelPage wrapCentering: #center.
+ !

Item was added:
+ ----- Method: PreferencesPanel>>addModelItemsToWindowMenu: (in category 'initialization') -----
+ addModelItemsToWindowMenu: aMenu
+ 	"aMenu is being constructed to be presented to the user in response to the user's pressing on the menu widget in the title bar of a morphic SystemWindow.  Here, the model is given the opportunity to add any model-specific items to the menu, whose default target is the SystemWindow itself."
+ 
+ 	true ifTrue: [^ self].  
+ 
+ 	"The below are provisionally disenfranchised, because their function is now directly available in the ? category"
+ 	aMenu addLine.
+ 	aMenu add: 'find preference... (f)' translated target: self action: #findPreference:.
+ 	aMenu add: 'inspect parameters' translated target: Preferences action: #inspectParameters!

Item was added:
+ ----- Method: PreferencesPanel>>adjustProjectLocalEmphasisFor: (in category 'initialization') -----
+ adjustProjectLocalEmphasisFor: aSymbol
+ 	"Somewhere, the preference represented by aSymbol got changed from being one that is truly global to one that varies by project, or vice-versa.  Get my panel right -- this involves changing the emphasis on the item"
+ 
+ 	| aWindow toFixUp allMorphs emphasis |
+ 	(aWindow _ self containingWindow) ifNil: [^ self].
+ 	emphasis _ (Preferences preferenceAt: aSymbol ifAbsent: [^ self]) localToProject
+ 		ifTrue:	[1 "bold for local-to-project"]
+ 		ifFalse:	[0 "plain for global"].
+ 	allMorphs _ IdentitySet new.
+ 	aWindow allMorphsAndBookPagesInto: allMorphs.
+ 	toFixUp _ allMorphs select:
+ 		[:m | (m isKindOf: StringMorph) and: [m contents = aSymbol]].
+ 	toFixUp do:
+ 		[:aStringMorph | aStringMorph emphasis: emphasis]
+ 
+ 	!

Item was added:
+ ----- Method: PreferencesPanel>>containingWindow (in category 'find') -----
+ containingWindow
+ 	"Answer the window in which the receiver is seen"
+ 
+ 	^ super containingWindow ifNil:
+ 		[Smalltalk isMorphic ifFalse: [self currentWorld]]!

Item was added:
+ ----- Method: PreferencesPanel>>findCategoryFromPreference: (in category 'find') -----
+ findCategoryFromPreference: prefSymbol
+ 	"Find all categories in which the preference occurs"
+ 
+ 	| aMenu| 
+ 	aMenu _ MenuMorph new defaultTarget: self.
+ 	(Preferences categoriesContainingPreference: prefSymbol) do:
+ 		[:aCategory | aMenu add: aCategory target: self selector: #switchToCategoryNamed:event: argumentList: {aCategory. MorphicEvent new}].
+ 	aMenu popUpInWorld!

Item was added:
+ ----- Method: PreferencesPanel>>findPreference: (in category 'find') -----
+ findPreference: evt
+ 	"Allow the user to submit a selector fragment; search for that among preference names; put up a list of qualifying preferences; if the user selects one of those, redirect the preferences panel to reveal the chosen preference"
+ 
+ 	self findPreferencesMatching: (FillInTheBlank request: 'Search for preferences containing:' translated initialAnswer: 'color')!

Item was added:
+ ----- Method: PreferencesPanel>>findPreferencesMatching: (in category 'initialization') -----
+ findPreferencesMatching: incomingTextOrString
+ 	"find all preferences matching incomingTextOrString"
+ 
+ 	| result aList aPalette controlPage cc |
+ 	result := incomingTextOrString asString asLowercase.
+ 	result := result asLowercase withBlanksTrimmed.
+ 	result isEmptyOrNil ifTrue: [^ self].
+ 
+ 	aList := Preferences allPreferenceObjects select:
+ 		[:aPreference | 
+ 			(aPreference name includesSubstring: result caseSensitive: false) or:
+ 				[aPreference helpString includesSubstring: result caseSensitive: false]].
+ 	aPalette := (self containingWindow ifNil: [^ self]) findDeeplyA: TabbedPalette.
+ 	aPalette ifNil: [^ self].
+ 	aPalette selectTabNamed:  'search results'.
+ 	aPalette currentPage ifNil: [^ self].  "bkwd compat"
+ 	controlPage := aPalette currentPage.
+ 	controlPage removeAllMorphs.
+ 	controlPage addMorph: (StringMorph contents: ('Preferences matching "', self searchString, '"') font: Preferences standardEToysButtonFont).
+ 	Preferences alternativeWindowLook ifTrue:[
+ 		cc := Color transparent.
+ 		controlPage color: cc].
+ 	aList := aList asSortedCollection:
+ 		[:a :b | a name < b name].
+ 	aList do:
+ 		[:aPreference | | button |
+ 			button _ aPreference representativeButtonWithColor: cc inPanel: self.
+ 			button ifNotNil: [controlPage addMorphBack: button]].
+ 	aPalette world startSteppingSubmorphsOf: aPalette!

Item was added:
+ ----- Method: PreferencesPanel>>findPreferencesMatchingSearchString (in category 'find') -----
+ findPreferencesMatchingSearchString
+ 	"find all preferences matching incomingTextOrString"
+ 
+ 	self findPreferencesMatching: self searchString!

Item was added:
+ ----- Method: PreferencesPanel>>initiateSearch: (in category 'find') -----
+ initiateSearch: morphHoldingSearchString
+ 	"Carry out the action of the Search button in the Preferences panel"
+ 
+ 	searchString _ morphHoldingSearchString text.
+ 	self setSearchStringTo: self searchString.
+ 	
+ 	self findPreferencesMatchingSearchString!

Item was added:
+ ----- Method: PreferencesPanel>>keyStroke: (in category 'find') -----
+ keyStroke: anEvent
+ 	"Handle a keystroke event in the panel; we map f (for find) into a switch to the ? category"
+ 
+ 	(anEvent keyCharacter == $f) ifTrue:
+ 		[^ self switchToCategoryNamed: #? event: nil]!

Item was added:
+ ----- Method: PreferencesPanel>>searchString (in category 'find') -----
+ searchString
+ 	"Answer the current searchString, initializing it if need be"
+ 
+ 	 | win aMorph |
+ searchString isEmptyOrNil ifTrue: 
+ 		[searchString _ 'Type here, hit Search' translated.
+ 		(win _ self containingWindow) ifNotNil:
+ 			[aMorph _ win findDeepSubmorphThat:
+ 					[:m | m isKindOf: PluggableTextMorph]
+ 				ifAbsent: [^ searchString].
+ 			aMorph setText: searchString.
+ 			aMorph setTextMorphToSelectAllOnMouseEnter.
+ 			aMorph selectAll]].
+ 	^ searchString!

Item was added:
+ ----- Method: PreferencesPanel>>setSearchStringTo: (in category 'find') -----
+ setSearchStringTo: aText
+ 	"The user submitted aText as the search string; now search for it"
+ 
+ 	searchString _ aText asString.
+ 	self findPreferencesMatching: searchString.
+ 	^ true!

Item was added:
+ ----- Method: PreferencesPanel>>switchToCategoryNamed:event: (in category 'category switch') -----
+ switchToCategoryNamed: aName event: anEvent
+ 	"Switch the panel so that it looks at the category of the given name"
+ 
+ 	| aPalette |
+ 	aPalette _ self containingWindow findDeeplyA: TabbedPalette.
+ 	aPalette ifNil: [^ self].
+ 	aPalette selectTabNamed: aName!

Item was added:
+ ----- Method: Presenter>>createStandardPlayer (in category '*Etoys-Squeakland-standardPlayer etc') -----
+ createStandardPlayer
+ 	| aMorph |
+ 
+ 	aMorph _ ImageMorph new image: (ScriptingSystem formAtKey: 'standardPlayer').
+ 	associatedMorph addMorphFront: aMorph.
+ 	(standardPlayer _ aMorph assuredPlayer) renameTo: 'dot' translated.
+ 	aMorph setBalloonText: '...'.
+ 	self positionStandardPlayer.
+ 	^ standardPlayer!

Item was added:
+ ----- Method: Presenter>>nascentPartsViewerFor: (in category '*Etoys-Squeakland-viewer') -----
+ nascentPartsViewerFor: aViewee
+ 	"Create a new, naked Viewer object for viewing aViewee.  Give it a vocabulary if either the viewee insists on one or if the project insists on one."
+ 
+ 	| aViewer aVocab |
+ 	(aViewee isKindOf: KedamaExamplerPlayer) ifTrue: [^ KedamaStandardViewer new].
+ 	aViewer _ StandardViewer new.
+ 	(aVocab _ aViewee vocabularyDemanded)
+ 		ifNotNil:
+ 			[aViewer useVocabulary: aVocab]
+ 		ifNil:
+ 			[(aVocab _ associatedMorph currentVocabularyFor: aViewee) ifNotNil:
+ 				[aViewer useVocabulary: aVocab]].
+ 	
+ 	"If the viewee does not *demand* a special kind of Viewer, and if the project has not specified a preferred vocabulary, then the system defaults will kick in later"
+ 	^ aViewer!

Item was added:
+ ----- Method: Presenter>>reallyAllExtantPlayers (in category '*Etoys-Squeakland-intialize') -----
+ reallyAllExtantPlayers
+ 	
+ 	^ ((self reallyAllExtantPlayersNoSort) asSortedCollection:
+ 			[:a :b | a externalName < b externalName]) asArray!

Item was added:
+ ----- Method: Presenter>>reallyAllExtantPlayersNoSort (in category '*Etoys-Squeakland-intialize') -----
+ reallyAllExtantPlayersNoSort
+ 	"The initial intent here was to produce a list of Player objects associated with any Morph in the tree beneath the receiver's associatedMorph.  whether it is the submorph tree or perhaps off on unseen bookPages.  We have for the moment moved away from that initial intent, and in the current version we only deliver up players associated with the submorph tree only.  <-- this note dates from 4/21/99"
+ 
+ 	| fullList objectsReferredToByTiles aSet fullClassList |
+ 	self flushPlayerListCache.
+ 	aSet _ IdentitySet new: 400.
+ 	associatedMorph allMorphsAndBookPagesInto: aSet.
+ 	fullList _ aSet select: 
+ 		[:m | m player ~~ nil] thenCollect: [:m | m player].
+ 	fullClassList := fullList collect: [:aPlayer | aPlayer class] thenSelect: [:aClass | aClass isUniClass].
+ 	fullClassList do:
+ 		[:aPlayerClass |
+ 			aPlayerClass scripts do:
+ 				[:aScript | aScript isTextuallyCoded ifFalse:
+ 					[aScript currentScriptEditor ifNotNilDo: [:ed |
+ 						objectsReferredToByTiles _ ed allMorphs
+ 							select:
+ 								[:aMorph | (aMorph isKindOf: TileMorph) and: [aMorph type == #objRef]]
+ 							thenCollect:
+ 								[:aMorph | aMorph actualObject].
+ 						fullList addAll: objectsReferredToByTiles]]]].
+ 
+ 	^ fullList!

Item was added:
+ ----- Method: Presenter>>reportPlayersAndScripts (in category '*Etoys-Squeakland-playerList') -----
+ reportPlayersAndScripts
+ 	"Open a window which contains a report on players and their scripts"
+ 
+ 	| aList aString |
+ 	self flushPlayerListCache.  "Just to be certain we get everything"
+ 	Smalltalk garbageCollect.
+ 	(aList _ self uniclassesAndCounts) ifEmpty:  [^ self inform: 'there are no scripted players' translated].
+ 	aString _ String streamContents:
+ 		[:aStream |
+ 			aList do:
+ 				[:aPair |
+ 					aStream nextPutAll: aPair first name, ' -- ', aPair second printString.
+ 					aStream nextPutAll: ' ', (aPair second > 1 ifTrue: ['instances'] ifFalse: ['instance']) translated, ', '.
+ 					aStream nextPutAll: 'named' translated.
+ 					aPair first allInstancesDo: [:inst | aStream space; nextPutAll: inst externalName].
+ 					aStream cr].
+ 			aStream cr.
+ 			aList do:
+ 				[:aPair |
+ 					aStream cr.
+ 					aStream nextPutAll: 
+ '--------------------------------------------------------------------------------------------'.
+ 					aStream cr; nextPutAll: aPair first typicalInstanceName.
+ 					aStream nextPutAll: '''s' translated.
+ 					aStream nextPutAll: ' scripts:' translated.
+ 					aPair first addDocumentationForScriptsTo: aStream]].
+ 
+ 	(StringHolder new contents: aString)
+ 		openLabel: 'All scripts in this project' translated
+ 
+ "self currentWorld presenter reportPlayersAndScripts"!

Item was added:
+ ----- Method: Presenter>>updateViewer:forceToShow: (in category '*Etoys-Squeakland-viewer') -----
+ updateViewer: aViewer forceToShow: aCategorySymbol
+ 	"Update the given viewer to make sure it is in step with various possible changes in the outside world, and when reshowing it be sure it shows the given category"
+ 
+ 	| aPlayer aPosition newViewer oldOwner wasSticky barHeight itsVocabulary aCategory categoryInfo restrictedIndex syms |
+ 	aCategory _ aCategorySymbol ifNotNil: [aViewer currentVocabulary translatedWordingFor: aCategorySymbol].
+ 	categoryInfo _ aViewer categoryMorphs asOrderedCollection collect:
+ 		[:aMorph | aMorph categoryRestorationInfo].
+ 
+ 	itsVocabulary _ aViewer currentVocabulary.
+ 	syms := aViewer symbolsOfCategoriesCurrentlyShowing.
+ 	aCategory ifNotNil: [(syms includes: aCategorySymbol) ifFalse:
+ 		[(syms isEmpty or: [syms first ~= #search])
+ 			ifTrue:
+ 				[categoryInfo addFirst: aCategorySymbol.]
+ 			ifFalse:
+ 				[categoryInfo add: aCategorySymbol afterIndex: 1]]].
+ 	aPlayer _ aViewer scriptedPlayer.
+ 	aPosition _ aViewer position.
+ 	wasSticky _ aViewer isSticky.
+ 	newViewer _ aViewer species new visible: false.
+ 	(aViewer isMemberOf: KedamaStandardViewer)
+ 		ifTrue: [restrictedIndex _ aViewer restrictedIndex].
+ 	barHeight _ aViewer submorphs first listDirection == #topToBottom
+ 		ifTrue:
+ 			[aViewer submorphs first submorphs first height]
+ 		ifFalse:
+ 			[0].
+ 	Preferences viewersInFlaps ifTrue:
+ 		[newViewer setProperty: #noInteriorThumbnail toValue: true].
+ 
+ 	newViewer rawVocabulary: itsVocabulary.
+ 	newViewer limitClass: aViewer limitClass.
+ 	newViewer initializeFor: aPlayer barHeight: barHeight includeDismissButton: aViewer hasDismissButton showCategories: categoryInfo.
+ 	(newViewer isMemberOf: KedamaStandardViewer)
+ 		ifTrue: [
+ 			newViewer providePossibleRestrictedView: 0.
+ 			newViewer providePossibleRestrictedView: restrictedIndex].
+ 	wasSticky ifTrue: [newViewer beSticky].
+ 	oldOwner _ aViewer owner.
+ 	oldOwner ifNotNil:
+ 		[oldOwner replaceSubmorph: aViewer by: newViewer].
+ 	
+ 	"It has happened that old readouts are still on steplist.  We may see again!!"
+ 
+ 	newViewer position: aPosition.
+ 	newViewer enforceTileColorPolicy.
+ 	newViewer visible: true.
+ 	newViewer world ifNotNilDo: [:aWorld | aWorld startSteppingSubmorphsOf: newViewer].
+ 	newViewer layoutChanged!

Item was added:
+ ----- Method: Presenter>>valueTiles (in category '*Etoys-Squeakland-tile support') -----
+ valueTiles
+ 	"Answer some constant-valued tiles.  This dates back to very early etoy work in 1997, and presently has no senders"
+ 
+ 	| tiles |
+ 	tiles _ OrderedCollection new.
+ 	tiles add: (5 newTileMorphRepresentative typeColor: (ScriptingSystem colorForType: #Number)).
+ 	tiles add: (ColorTileMorph new typeColor: (ScriptingSystem colorForType: #Color)).
+ 	tiles add: (TileMorph new typeColor: (ScriptingSystem colorForType: #Number);
+ 			setExpression: '(180 atRandom)'
+ 			label: 'random').
+ 	tiles add: FunctionTile randomNumberTile.
+ 	^ tiles!

Item was added:
+ Object subclass: #PrimitiveNode
+ 	instanceVariableNames: 'primitiveNum spec'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Compiler-Syntax'!
+ 
+ !PrimitiveNode commentStamp: 'ajh 3/24/2003 21:35' prior: 0!
+ I represent a primitive.  I am more than just a number if I am a named primitive.
+ 
+ Structure:
+ 
+  num	<Integer>	Primitive number.
+  spec	<Object>		Stored in first literal when num is 117 or 120.
+ !

Item was added:
+ ----- Method: PrimitiveNode class>>null (in category 'as yet unclassified') -----
+ null
+ 
+ 	^ self new num: 0!

Item was added:
+ ----- Method: PrimitiveNode>>num (in category 'as yet unclassified') -----
+ num
+ 
+ 	^ primitiveNum!

Item was added:
+ ----- Method: PrimitiveNode>>num: (in category 'as yet unclassified') -----
+ num: n
+ 
+ 	primitiveNum _ n!

Item was added:
+ ----- Method: PrimitiveNode>>printOn: (in category 'as yet unclassified') -----
+ printOn: aStream
+ 
+ 	aStream nextPutAll: 'primitive '; print: primitiveNum!

Item was added:
+ ----- Method: PrimitiveNode>>printPrimitiveOn: (in category 'as yet unclassified') -----
+ printPrimitiveOn: aStream 
+ 	"Print the primitive on aStream"
+ 
+ 	| primIndex primDecl |
+ 	primIndex _ primitiveNum.
+ 	primIndex = 0 ifTrue: [^ self].
+ 	primIndex = 120 ifTrue: [
+ 		"External call spec"
+ 		^ aStream print: spec].
+ 	aStream nextPutAll: '<primitive: '.
+ 	primIndex = 117 ifTrue: [
+ 		primDecl _ spec.
+ 		aStream nextPut: $';
+ 			nextPutAll: (primDecl at: 2);
+ 			nextPut: $'.
+ 		(primDecl at: 1) ifNotNil: [
+ 			aStream nextPutAll: ' module: ';
+ 				nextPut: $';
+ 				nextPutAll: (primDecl at: 1);
+ 				nextPut: $'].
+ 	] ifFalse: [aStream print: primIndex].
+ 	aStream nextPut: $>.
+ 	(primIndex ~= 117 and: [primIndex ~= 120]) ifTrue: [
+ 		Smalltalk at: #Interpreter ifPresent: [:cls |
+ 			aStream nextPutAll: ' "', 
+ 				((cls classPool at: #PrimitiveTable) at: primIndex + 1) , '" '
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: PrimitiveNode>>sourceText (in category 'as yet unclassified') -----
+ sourceText
+ 
+ 	^ String streamContents: [:stream |
+ 		self printPrimitiveOn: stream]!

Item was added:
+ ----- Method: PrimitiveNode>>spec (in category 'as yet unclassified') -----
+ spec
+ 
+ 	^ spec!

Item was added:
+ ----- Method: PrimitiveNode>>spec: (in category 'as yet unclassified') -----
+ spec: literal
+ 
+ 	spec _ literal!

Item was added:
+ TextComponent subclass: #PrintComponent
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Components'!

Item was added:
+ ----- Method: PrintComponent>>accept (in category 'menu commands') -----
+ accept
+ 	"Inform the model of text to be accepted, and return true if OK."
+ 
+ 	| textToAccept |
+ 	self canDiscardEdits ifTrue: [^self flash].
+ 	setTextSelector isNil ifTrue: [^self].
+ 	textToAccept := textMorph asText.
+ 	model perform: setTextSelector
+ 		with: (Compiler evaluate: textToAccept logged: false).
+ 	self setText: textToAccept.
+ 	self hasUnacceptedEdits: false!

Item was added:
+ ----- Method: PrintComponent>>getText (in category 'model access') -----
+ getText
+ 	"Retrieve the current model text"
+ 
+ 	getTextSelector isNil ifTrue: [^Text new].
+ 	^(model perform: getTextSelector) printString asText!

Item was added:
+ ----- Method: PrintComponent>>initPinSpecs (in category 'components') -----
+ initPinSpecs 
+ 	pinSpecs _ Array
+ 		with: (PinSpec new pinName: 'value' direction: #inputOutput
+ 				localReadSelector: nil localWriteSelector: nil
+ 				modelReadSelector: getTextSelector modelWriteSelector: setTextSelector
+ 				defaultValue: nil pinLoc: 1.5)!

Item was added:
+ PrintableEncoder subclass: #PrintEncoder
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-MorphicExtras-Postscript Filters'!

Item was added:
+ ----- Method: PrintEncoder class>>filterSelector (in category 'configuring') -----
+ filterSelector
+ 	^#printOnStream:!

Item was added:
+ ----- Method: Process>>debug:title:full:contents: (in category '*Etoys-Squeakland-debugging') -----
+ debug: context title: title full: bool contents: contents
+ 	"Open debugger on self with context shown on top"
+ 
+ 	| topCtxt |
+ 	topCtxt _ self isActiveProcess ifTrue: [thisContext] ifFalse: [self suspendedContext].
+ 	(topCtxt hasContext: context) ifFalse: [^ self error: 'context not in process'].
+ 	Debugger openOn: self context: context label: title contents: contents fullView: bool.
+ !

Item was added:
+ ----- Method: Process>>errorHandler (in category '*Etoys-Squeakland-error handling') -----
+ errorHandler
+     ^ errorHandler!

Item was added:
+ ----- Method: Process>>errorHandler: (in category '*Etoys-Squeakland-error handling') -----
+ errorHandler: aBlock
+     errorHandler _ aBlock!

Item was added:
+ ----- Method: ProgressInitiationException class>>display:during: (in category '*Etoys-Squeakland-signalling') -----
+ display: aString during: workBlock 
+ 	"Show progress bar; the position should be standardize from 0 to 1"
+ 	"ProgressInitiationException display: 'progress' during: [:bar | 
+ 		0 to: 1 by: 0.1 do: [:x | bar value: x.
+ 			(Delay forMilliseconds: 100) wait]]"
+ 	^ self new
+ 		display: aString
+ 		at: Sensor cursorPoint
+ 		from: 0
+ 		to: 1
+ 		during: workBlock!

Item was added:
+ ----- Method: ProgressInitiationException>>defaultMorphicAction (in category '*Etoys-Squeakland-as yet unclassified') -----
+ defaultMorphicAction
+ 	| result progress |
+ 	progress _ SystemProgressMorph label: progressTitle min: minVal max: maxVal.
+ 	[result _ workBlock value: progress] ensure: [SystemProgressMorph close: progress].
+ 	self resume: result!

Item was added:
+ ----- Method: ProgressInitiationException>>suppressFileInProgressBar (in category '*Etoys-Squeakland-as yet unclassified') -----
+ suppressFileInProgressBar
+ 	self signalerContext sender method = (PositionableStream >> #fileInAnnouncing:)
+ 		ifTrue: [self
+ 				sendNotificationsTo: [:min :max :curr | curr]]
+ 		ifFalse: [self pass]!

Item was added:
+ ----- Method: Project class>>enterNew (in category '*Etoys-Squeakland-instance creation') -----
+ enterNew
+ 	| newP |
+ 	newP := Project newMorphicOn: nil.
+ 	newP enter!

Item was added:
+ ----- Method: Project class>>enterNewWithInitialBalloons (in category '*Etoys-Squeakland-instance creation') -----
+ enterNewWithInitialBalloons
+ 	| newP |
+ 	newP := Project newMorphicOn: nil.
+ 	newP world addMorph: (DoCommandOnceMorph new extent: 1 at 1; actionBlock: [SugarNavigatorBar putUpInitialBalloonHelp]; deleteAfterExecution: true; yourself).
+ 
+ 	newP enter.
+ !

Item was added:
+ ----- Method: Project class>>fromExampleEtoys: (in category '*Etoys-Squeakland-squeaklet on server') -----
+ fromExampleEtoys: urlString
+ 	| pair projName proj triple serverDir projectFilename |
+ 	Project canWeLoadAProjectNow ifFalse: [^ self].
+ 
+ 	projectFilename _ urlString.
+ 	triple _ Project parseProjectFileName: projectFilename unescapePercents.
+ 	projName _ triple first.
+ 	(proj _ Project named: projName)
+ 		ifNotNil: ["it appeared" ^ ProjectEntryNotification signal: proj].
+ 
+ 	serverDir _ FileDirectory on: (Smalltalk imagePath, FileDirectory slash, 'ExampleEtoys').
+ 
+ 	pair _ self mostRecent: projectFilename onServer: serverDir.
+ 	"Pair first is name exactly as it is on the server"
+ 	pair first ifNil: [^self openBlankProjectNamed: projName].
+ 
+ 	ProjectLoading
+ 		installRemoteNamed: pair first
+ 		from: serverDir
+ 		named: projName
+ 		in: CurrentProject.!

Item was added:
+ ----- Method: Project class>>home (in category '*Etoys-Squeakland-constants') -----
+ home
+ 	"Answer the home project."
+ 
+ 	^self named: 'Home'
+ !

Item was added:
+ ----- Method: Project class>>interruptName:preemptedProcess: (in category '*Etoys-Squeakland-utilities') -----
+ interruptName: labelString preemptedProcess: theInterruptedProcess
+ 	"Create a Notifier on the active scheduling process with the given label."
+ 	| preemptedProcess projectProcess |
+ 	Smalltalk isMorphic ifFalse:
+ 		[^ ScheduledControllers interruptName: labelString].
+ 	ActiveHand ifNotNil:[ActiveHand interrupted].
+ 	ActiveWorld := World. "reinstall active globals"
+ 	ActiveHand := World primaryHand.
+ 	ActiveHand interrupted. "make sure this one's interrupted too"
+ 	ActiveEvent := nil.
+ 
+ 	projectProcess := self uiProcess.	"we still need the accessor for a while"
+ 	preemptedProcess := theInterruptedProcess ifNil: [Processor preemptedProcess].
+ 	"Only debug preempted process if its priority is >= projectProcess' priority"
+ 	preemptedProcess priority < projectProcess priority 
+ 		ifTrue:[preemptedProcess := projectProcess].
+ 	preemptedProcess suspend.
+ 	Debugger openInterrupt: labelString onProcess: preemptedProcess
+ !

Item was added:
+ ----- Method: Project>>acceptDetailsAndStoreProject: (in category '*Etoys-Squeakland-menu messages') -----
+ acceptDetailsAndStoreProject: details
+ 	"The user having hit the ok button in the dialog, send the details back to the project, store the project on the server, "
+ 
+ 	self acceptProjectDetails: details.
+ 
+ 	self isCurrentProject
+ 		ifTrue:
+ 			["exit, then do the command"
+ 			self
+ 				armsLengthCommand: #storeOnServerAssumingNameValid
+ 				withDescription: 'Publishing' translated]
+ 		ifFalse:
+ 			[self storeOnServerWithProgressInfo]!

Item was added:
+ ----- Method: Project>>acceptDetailsAndStoreProjectWithForget: (in category '*Etoys-Squeakland-menu messages') -----
+ acceptDetailsAndStoreProjectWithForget: details
+ 	"The user having hit the ok button in the dialog, send the details back to the project, store the project on the server, "
+ 
+ 	self acceptProjectDetails: details.
+ 
+ 	self isCurrentProject
+ 		ifTrue:
+ 			["exit, then do the command"
+ 			(world hasProperty: #forgetURL)
+ 					ifTrue: [self forgetExistingURL]
+ 					ifFalse: [urlList isEmptyOrNil ifTrue: [urlList _ parentProject urlList]]. 
+ 			self
+ 				armsLengthCommand: #storeOnServerAssumingNameValid
+ 				withDescription: 'Publishing' translated]
+ 		ifFalse:
+ 			[self storeOnServerWithProgressInfo]!

Item was added:
+ ----- Method: Project>>acceptProjectDetails: (in category '*Etoys-Squeakland-menu messages') -----
+ acceptProjectDetails: details
+ 	"Store project details back into a property of the world, and if a name is provided, make sure the name is properly installed in the project."
+ 
+ 	world setProperty: #ProjectDetails toValue: details.
+ 	details at: 'projectname' ifPresent: [ :newName | 
+ 		self renameTo: newName]!

Item was added:
+ ----- Method: Project>>beIsolated (in category '*Etoys-Squeakland-isolation layers') -----
+ beIsolated
+ 	"Establish an isolation layer at this project.
+ 	This requires clearing the current changeSet or installing a new one."
+ 
+ 	isolatedHead ifTrue: [^ self error: 'Already isolated'].
+ 	self isCurrentProject ifFalse:
+ 		[^ self inform: 'Must be in this project to isolate it' translated.].
+ 	changeSet isEmpty ifFalse: [changeSet _ ChangeSorter newChangeSet].
+ 	changeSet beIsolationSetFor: self.
+ 	isolatedHead _ true.
+ 	inForce _ true.
+ 	environment _ Environment new setName: self name outerEnvt: Smalltalk.
+ 
+ !

Item was added:
+ ----- Method: Project>>compressFilesIn:to:in: (in category '*Etoys-Squeakland-file in/out') -----
+ compressFilesIn: tempDir to: localName in: localDirectory
+ 	"Compress all the files in tempDir making up a zip file in localDirectory named localName"
+ 
+ 	| archive archiveName entry fileNames |
+ 	archive := ZipArchive new.
+ 	fileNames := tempDir fileNames.
+ 	(fileNames includes: 'manifest')
+ 		ifTrue: [fileNames := #('manifest'), (fileNames copyWithout: 'manifest')].
+ 	fileNames do:[:fn|
+ 		archiveName := fn.
+ 		entry := archive addFile: (tempDir fullNameFor: fn) as: archiveName.
+ 		entry desiredCompressionMethod: (
+ 			fn = 'manifest'
+ 				ifTrue: [ZipArchive compressionLevelNone] 
+ 				ifFalse: [ZipArchive compressionDeflated]).
+ 	].
+ 	archive writeToFileNamed: (localDirectory fullNameFor: localName).
+ 	archive close.
+ 	tempDir fileNames do:[:fn|
+ 		tempDir deleteFileNamed: fn ifAbsent:[]].
+ 	localDirectory deleteDirectory: tempDir localName.!

Item was added:
+ ----- Method: Project>>createViewIfAppropriate (in category '*Etoys-Squeakland-displaying') -----
+ createViewIfAppropriate
+ 	"Create a project view for the receiver and place it appropriately on the screen."
+ 
+ 	| aMorph requiredWidth existing proposedV proposedH despair |
+ 	ProjectViewOpenNotification signal ifTrue:
+ 		[Preferences projectViewsInWindows
+ 			ifTrue:
+ 				[(ProjectViewMorph newProjectViewInAWindowFor: self) openInWorld]
+ 			ifFalse:
+ 				[aMorph := ProjectViewMorph on: self.
+ 				requiredWidth := aMorph width + 10.
+ 				existing := ActiveWorld submorphs
+ 					select: [:m | m isKindOf: ProjectViewMorph]
+ 					thenCollect: [:m | m fullBoundsInWorld].
+ 				proposedV := 85.
+ 				proposedH := 10.
+ 				despair := false.
+ 				[despair not and: [((proposedH @ proposedV) extent: requiredWidth) intersectsAny: existing]] whileTrue:
+ 					[proposedH := proposedH + requiredWidth.
+ 					proposedH + requiredWidth > ActiveWorld right ifTrue:
+ 						[proposedH := 10.
+ 						proposedV := proposedV + 90.
+ 						proposedV > (ActiveWorld bottom - 90)
+ 							ifTrue:
+ 								[proposedH := ActiveWorld center x - 45.
+ 								proposedV := ActiveWorld center y - 30.
+ 								despair := true]]].
+ 				aMorph position: (proposedH @ proposedV).
+ 				aMorph openInWorld]]!

Item was added:
+ ----- Method: Project>>defaultFolderForAutoSaving (in category '*Etoys-Squeakland-file in/out') -----
+ defaultFolderForAutoSaving
+ 
+ 	^ ServerDirectory servers at: SugarLauncher defaultDatastoreDirName ifAbsent: [^ FileDirectory default].
+ !

Item was added:
+ ----- Method: Project>>deletePrevious (in category '*Etoys-Squeakland-initialization') -----
+ deletePrevious
+ 
+ 	| p oldView |
+ 	p _ Project current previousProject.
+ 	oldView _ ProjectViewMorph allInstances detect: [:v |
+ 			v project == p and: [v world == ActiveWorld]] ifNone: [].
+ 	oldView ifNotNil: [oldView project okToChangeSilently].
+ 	oldView ifNotNil: [oldView delete].
+ !

Item was added:
+ ----- Method: Project>>displayExtent (in category '*Etoys-Squeakland-displaying') -----
+ displayExtent
+ 	"Answer the requested extent for this project"
+ 	| ext |
+ 	Preferences enableVirtualOLPCDisplay ifFalse:[^Display extent].
+ 	ext := OLPCVirtualScreen virtualScreenExtent.
+ 	^(projectPreferenceFlagDictionary at: #enablePortraitMode ifAbsent:[false])
+ 		ifTrue:[ext transposed]
+ 		ifFalse:[ext].!

Item was added:
+ ----- Method: Project>>displayFontProgress (in category '*Etoys-Squeakland-menu messages') -----
+ displayFontProgress
+ 	"Display progress for fonts"
+ 	
+ 	^ self displayProgressWithMessage: '$	Fixing fonts	$	' translated!

Item was added:
+ ----- Method: Project>>displayProgressWithJump: (in category '*Etoys-Squeakland-menu messages') -----
+ displayProgressWithJump: aMessage
+ 	"Answer a block to display progress while some time-consuming action is going on; the message provided is shown within a tableau of special chars.  This is basically Andreas's code."
+ 
+ 	| done b guy guys c text idx |
+ 	done := false.
+ 	b := ScriptableButton new.
+ 	guy _ TextMorph new.
+ 	guy usePango: false.
+ 	guys _ #('\o/
+ _I_
+ ' '_o_
+ I
+ /  \' 'o
+ / I \
+ | |' '_o_
+ I
+ /  \').
+ 
+ 	b color: Color yellow.
+ 	b borderWidth: 1; borderColor: Color black.
+ 	[
+ 		idx _ 0.
+ 		[done] whileFalse:[
+ 			c _ Display getCanvas.
+ 			b label: aMessage font: (Preferences standardEToysFont emphasized: 1).
+ 			b extent: 200 at 100.
+ 			b center: Display center.
+ 			b fullDrawOn: Display getCanvas.
+ 			guy beAllFont: (Preferences standardEToysFont  emphasized: 1).
+ 			text _ (guys atWrap: (idx := idx + 1)) asText.
+ 			text addAttribute: (TextAlignment centered) from: 1 to: text string size.
+ 			guy contents: text.
+ 			guy center: b position + (30 at 50); top: b top + 20.
+ 			guy fullDrawOn: c.
+ 			guy center: b position + (170 at 50); top: b top + 20.
+ 			guy fullDrawOn: c.
+ 			Display forceToScreen: b bounds.
+ 			(Delay forMilliseconds: 500) wait.
+ 		].
+ 	] forkAt: Processor userInterruptPriority.
+ 	^[done := true]!

Item was added:
+ ----- Method: Project>>displayProgressWithMessage: (in category '*Etoys-Squeakland-menu messages') -----
+ displayProgressWithMessage:  aMessage
+ 	"Answer a block to display progress while some time-consuming action is going on; the message provided is shown within a tableau of special chars.  This is basically Andreas's code."
+ 
+ 	| done b pp |
+ 	done := false.
+ 	b := ScriptableButton new.
+ 	b color: Color yellow.
+ 	b borderWidth: 1; borderColor: Color black.
+ 	pp := [	| dots str idx |
+ 		dots := #(' - ' ' \ ' ' | ' ' / '). idx := 0.
+ 		[done] whileFalse:[
+ 			str _ aMessage.
+ 			str := str copyReplaceTokens: '$' with: (dots atWrap: (idx := idx + 1)) asString.
+ 			b label: str font: (Preferences standardEToysFont emphasized: 1).
+ 			b extent: 200 at 50.
+ 			b center: Display center.
+ 			b fullDrawOn: Display getCanvas.
+ 			(Delay forMilliseconds: 1000) wait.
+ 		].
+ 	] forkAt: Processor userInterruptPriority.
+ 	^[done := true]!

Item was added:
+ ----- Method: Project>>displaySavingProgress (in category '*Etoys-Squeakland-menu messages') -----
+ displaySavingProgress
+ 	"Display progress for fonts"
+ 	
+ 	^ self displayProgressWithJump: 'Saving' translated!

Item was added:
+ ----- Method: Project>>exportSegmentFileName:directory:withoutInteraction: (in category '*Etoys-Squeakland-file in/out') -----
+ exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: noInteraction
+ 
+ 	| exportChangeSet |
+ 
+ 	"An experimental version to fileout a changeSet first so that a project can contain its own classes"
+ 
+ 	self projectParameterAt: #eToysFont put: (Preferences standardEToysFont familySizeFace).
+ 
+ 	"Store my project out on the disk as an *exported* ImageSegment.  Put all outPointers in a form that can be resolved in the target image.  Name it <project name>.extSeg.
+ 	Player classes are included automatically."
+ 	exportChangeSet _ nil.
+ 	(changeSet notNil and: [changeSet isEmpty not]) ifTrue: [
+ 		(noInteraction or: [self confirm: 
+ 	'Would you like to include all the changes in the change set
+ 	as part of this publishing operation?' translated]) ifTrue: [
+ 				exportChangeSet _ changeSet
+ 		].
+ 	].
+ 
+ 	Project publishInSexp ifTrue: [
+ 		^ self exportSegmentInSexpWithChangeSet: exportChangeSet fileName: aFileName directory: aDirectory withoutInteraction: noInteraction
+ 	].
+ 	^ self 
+ 		exportSegmentWithChangeSet: exportChangeSet
+ 		fileName: aFileName 
+ 		directory: aDirectory
+ 		withoutInteraction: noInteraction
+ !

Item was added:
+ ----- Method: Project>>exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction: (in category '*Etoys-Squeakland-file in/out') -----
+ exportSegmentInSexpWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory withoutInteraction: noInteraction
+ 
+ 	| fd sexp actualName |
+ 
+ 	world ifNil: [^ false].
+ 	world presenter ifNil: [^ false].
+ 
+ 	Command initialize.
+ 	world clearCommandHistory.
+ 	world cleanseStepList.
+ 	world localFlapTabs size = world flapTabs size ifFalse: [
+ 		noInteraction ifTrue: [^ false].
+ 		self error: 'Still holding onto Global flaps'].
+ 
+ 	fd _ aDirectory directoryNamed: self resourceDirectoryName.
+ 	fd assureExistence.
+ 
+ 	"Must activate old world because this is run at #armsLength.
+ 	Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent
+ 	will not be captured correctly if referenced from blocks or user code."
+ 	world becomeActiveDuring:[
+ 		sexp _ world sissScanObjectsAsEtoysProject.
+ 	].
+ 	(aFileName endsWith: '.pr') ifTrue: [
+ 		actualName _ (aFileName copyFrom: 1 to: aFileName size - 3), '.sexp'.
+ 	] ifFalse: [
+ 		actualName _ aFileName
+ 	].
+ 
+ 	self
+ 		writeForExportInSexp: sexp withSources: actualName
+ 		inDirectory: fd
+ 		changeSet: aChangeSetOrNil.
+ 	SecurityManager default signFile: actualName directory: fd.
+ 	self storeHtmlPageIn: fd.
+ 	self storeManifestFileIn: fd.
+ 	self compressFilesIn: fd to: aFileName in: aDirectory.
+ 
+ 	^ true
+ !

Item was added:
+ ----- Method: Project>>exportSegmentWithChangeSet:fileName:directory:withoutInteraction: (in category '*Etoys-Squeakland-file in/out') -----
+ exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory withoutInteraction: noInteraction
+ 	"Store my project out on the disk as an *exported* ImageSegment.  All outPointers will be in a form that can be resolved in the target image.  Name it <project name>.extSeg.  Whatdo we do about subProjects, especially if they are out as local image segments?  Force them to come in?
+ 	Player classes are included automatically."
+ 
+ 	| is str ans revertSeg roots holder collector fd mgr stacks |
+ 
+ 	"Files out a changeSet first, so that a project can contain its own classes"
+ 	world isMorph ifFalse: [
+ 		self projectParameters at: #isMVC put: true.
+ 		^ false].	"Only Morphic projects for now"
+ 	world ifNil: [^ false].  world presenter ifNil: [^ false].
+ 
+ 	Utilities emptyScrapsBook.
+ 	
+ 	world cleanUpReferences.
+ 
+ 	world currentHand pasteBuffer: nil.	  "don't write the paste buffer."
+ 	world currentHand mouseOverHandler initialize.	  "forget about any references here"
+ 	"Display checkCurrentHandForObjectToPaste."
+ 	Command initialize.
+ 	world clearCommandHistory.
+ 	world fullReleaseCachedState; releaseViewers.
+ 	world cleanseStepList.
+ 	world localFlapTabs size = world flapTabs size ifFalse: [
+ 		noInteraction ifTrue: [^ false].
+ 		self error: 'Still holding onto Global flaps'].
+ 	world releaseSqueakPages.
+ 	ScriptEditorMorph writingUniversalTiles: (self projectParameterAt: #universalTiles ifAbsent: [false]).
+ 	holder _ Project allProjects.	"force them in to outPointers, where DiskProxys are made"
+ 
+ 	"Just export me, not my previous version"
+ 	revertSeg _ self projectParameters at: #revertToMe ifAbsent: [nil].
+ 	self projectParameters removeKey: #revertToMe ifAbsent: [].
+ 
+ 	roots _ OrderedCollection new.
+ 	roots add: self; add: world; add: transcript; add: changeSet; add: thumbnail.
+ 	roots add: world activeHand.
+ 	"; addAll: classList; addAll: (classList collect: [:cls | cls class])"
+ 
+ 	roots _ roots reject: [ :x | x isNil].	"early saves may not have active hand or thumbnail"
+ 
+ 	fd _ aDirectory directoryNamed: self resourceDirectoryName.
+ 	fd assureExistence.
+ 	"Clean up resource references before writing out"
+ 	mgr _ self resourceManager.
+ 	self resourceManager: nil.
+ 	ResourceCollector current: ResourceCollector new.
+ 	ResourceCollector current localDirectory: fd.
+ 	ResourceCollector current baseUrl: self resourceUrl.
+ 	ResourceCollector current initializeFrom: mgr.
+ 	ProgressNotification signal: '2:findingResources' extra: '(collecting resources...)' translated.
+ 	"Must activate old world because this is run at #armsLength.
+ 	Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent
+ 	will not be captured correctly if referenced from blocks or user code."
+ 	world becomeActiveDuring:[
+ 		is _ ImageSegment new copySmartRootsExport: roots asArray.
+ 		"old way was (is _ ImageSegment new copyFromRootsForExport: roots asArray)"
+ 	].
+ 	self resourceManager: mgr.
+ 	collector _ ResourceCollector current.
+ 	ResourceCollector current: nil.
+ 	ProgressNotification signal: '2:foundResources' extra: ''.
+ 	is state = #tooBig ifTrue: [
+ 		collector replaceAll.
+ 		^ false].
+ 
+ 	str _ ''.
+ 	"considered legal to save a project that has never been entered"
+ 	(is outPointers includes: world) ifTrue: [
+ 		str _ str, '\Project''s own world is not in the segment.' translated withCRs].
+ 	str isEmpty ifFalse: [
+ 		ans _ noInteraction ifTrue: [2] ifFalse: [(PopUpMenu labels: 'Do not write file
+ Write file anyway
+ Debug' translated) startUpWithCaption: str].
+ 		ans = 1 ifTrue: [
+ 			revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg].
+ 			collector replaceAll.
+ 			^ false].
+ 		ans = 3 ifTrue: [
+ 			collector replaceAll.
+ 			self error: 'Segment not written' translated]].
+ 	stacks _ is findStacks.
+ 
+ 	is
+ 		writeForExportWithSources: aFileName
+ 		inDirectory: fd
+ 		changeSet: aChangeSetOrNil.
+ 	SecurityManager default signFile: aFileName directory: fd.
+ 	"Compress all files and update check sums"
+ 	collector forgetObsolete.
+ 	self storeResourceList: collector in: fd.
+ 	self storeHtmlPageIn: fd.
+ 	self storeManifestFileIn: fd.
+ 	self storePngThumbnailIn: fd.
+ 	self writeStackText: stacks in: fd registerIn: collector.
+ 	"local proj.005.myStack.t"
+ 	self compressFilesIn: fd to: aFileName in: aDirectory resources: collector.
+ 			"also deletes the resource directory"
+ 	"Now update everything that we know about"
+ 	mgr updateResourcesFrom: collector.
+ 
+ 	revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg].
+ 	holder.
+ 
+ 	collector replaceAll.
+ 
+ 	world flapTabs do: [:ft |
+ 		(ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]].
+ 	is arrayOfRoots do: [:obj |
+ 		obj class == ScriptEditorMorph ifTrue: [obj unhibernate]].
+ 	^ true
+ !

Item was added:
+ ----- Method: Project>>helpGuideIfOpen (in category '*Etoys-Squeakland-flaps support') -----
+ helpGuideIfOpen
+ 	"Return the QuickGuideMorph of the help flap if it is open.  Return nil if the Help flap is closed or if there is no help flap."
+ 
+ 	| ref ff |
+ 	ff _ Flaps globalFlapTab: 'Help' translated.
+ 	ff ifNil: [^ nil].
+ 	ff isInWorld ifFalse: [^ nil].
+ 	ff flapShowing ifFalse: [^ nil].
+ 	ref _ ff referent.
+ 	ref ifNil: [^ nil].
+ 	^ ref findDeeplyA: QuickGuideMorph
+ !

Item was added:
+ ----- Method: Project>>initMorphic (in category '*Etoys-Squeakland-initialization') -----
+ initMorphic
+ 	"Written so that Morphic can still be removed.  Note that #initialize is never actually called for a morphic project -- see the senders of this method."
+ 
+ 	Smalltalk verifyMorphicAvailability ifFalse: [^ nil].
+ 	changeSet := ChangeSet new.
+ 	transcript := TranscriptStream new.
+ 	displayDepth := Display depth.
+ 	parentProject := CurrentProject.
+ 	isolatedHead := false.
+ 	world := PasteUpMorph newWorldForProject: self.
+ 	"Locale switchToID: CurrentProject localeID."
+ 	self initializeProjectPreferences. "Do this *after* a world is installed so that the project will be recognized as a morphic one."
+ 	Preferences useVectorVocabulary ifTrue: [world installVectorVocabulary]!

Item was added:
+ ----- Method: Project>>installVirtualDisplayIfNeededFor: (in category '*Etoys-Squeakland-initialization') -----
+ installVirtualDisplayIfNeededFor: ext
+ 
+ 	| actual allowance |
+ 	allowance := 50.
+ 	actual := Display class actualScreenSize.
+ 	actual = OLPCVirtualScreen defaultVirtualScreenExtent ifTrue: [^ self].
+ 	(Display isVirtualScreen and: [Display extent = ext]) ifTrue: [^ self].
+ 	((ext x > (actual x + allowance)) or: [ext y > (actual y + allowance)]) ifTrue: [
+ 		OLPCVirtualScreen virtualScreenExtent: ext.
+ 		OLPCVirtualScreen install.
+ 		^ self
+ 	].
+ 	((ext x <= (actual x - allowance)) and: [ext y <= (actual y - allowance)]) ifTrue: [
+ 		OLPCVirtualScreen virtualScreenExtent: ext.
+ 		OLPCVirtualScreen install.
+ 		Display zoomOut: true.
+ 		^ self.
+ 	].
+ 
+ 	OLPCVirtualScreen virtualScreenExtent: nil.
+ 	OLPCVirtualScreen unInstall.
+ !

Item was added:
+ ----- Method: Project>>keepSugarProperties:monitor: (in category '*Etoys-Squeakland-sugar') -----
+ keepSugarProperties: aDictionary monitor: aBoolean
+ 	| dontKeep props |
+ 	aDictionary at: 'title' ifPresent: [:title | self name: title].
+ 	dontKeep := #('activity' 'activity_id' 'title' 'title_set_by_user' 'keep' 'mtime' 'timestamp' 'preview' 'icon-color' 'mime_type') asSet.
+ 	props := Dictionary new: aDictionary size.
+ 	aDictionary keysAndValuesDo: [:key :value |
+ 		(dontKeep includes: key) ifFalse: [props at: key put: value]].
+ 	self sugarProperties: props.
+ 	aBoolean ifTrue: [
+ 		self sugarObjectId ifNotNilDo: [:id |
+ 			SugarLauncher current monitorJournalEntry: id]].!

Item was added:
+ ----- Method: Project>>locales (in category '*Etoys-Squeakland-language') -----
+ locales
+ 	"Answer list of all locales found in translatable objects"
+ 	| locales |
+ 	locales := Set new.
+ 	world allMorphsDo: [:m |
+ 		((m isKindOf: TextMorph) and: [m translatable]) ifTrue: [
+ 			m valueOfProperty: #translations ifPresentDo: [:translations |
+ 				translations keysDo: [:locale | locales add: locale]]]].
+ 	^locales!

Item was added:
+ ----- Method: Project>>localesString (in category '*Etoys-Squeakland-language') -----
+ localesString
+ 	"Answer comma-separated string of all locales found in translatable objects"
+ 	^String streamContents: [:stream | 
+ 		self locales
+ 			do: [:locale | stream print: locale]
+ 			separatedBy: [stream nextPut: $,]]!

Item was added:
+ ----- Method: Project>>name: (in category '*Etoys-Squeakland-accessing') -----
+ name: aString
+ 	changeSet ifNil: [changeSet := ChangeSet new].
+ 	(aString isEmpty or: [aString = changeSet name])
+ 		ifFalse: [changeSet name: (ChangeSet uniqueNameLike: aString)]!

Item was added:
+ ----- Method: Project>>nameChangedWhileCurrent (in category '*Etoys-Squeakland-accessing') -----
+ nameChangedWhileCurrent
+ 	Preferences projectNameInTitle ifTrue: [
+ 		| title |
+ 		title := self name ifNil: [''].
+ 		(title beginsWith: 'zzTemp') ifTrue: [title := ''].
+ 		title ifNotEmpty: [title := ': ', title].
+ 		title := SystemVersion current baseName capitalized, title.
+ 		DisplayScreen hostWindowTitle: title].!

Item was added:
+ ----- Method: Project>>noteManifestDetailsIn: (in category '*Etoys-Squeakland-file in/out') -----
+ noteManifestDetailsIn: manifestInfo
+ 	"The receiver is a project being loaded.  From the dictionary provided, absorb and remember whether it's an 'old' (pre-olpc) project, and remember the GUID, user, and prev-GUID associated with the project when these data are available in the incoming manifest."
+ 
+ 	| manifestDict oldProject |
+ 	manifestInfo isEmptyOrNil ifTrue: [^ self projectParameterAt: #oldProject put: true].
+ 
+ 	manifestDict := (manifestInfo isKindOf: Dictionary) ifTrue: [manifestInfo] ifFalse: [manifestInfo first].
+ 
+ 	oldProject := ((manifestDict at: 'Squeak-Version' ifAbsent: ['']) beginsWith: 'etoys') not.
+ 	self projectParameterAt: #oldProject put: oldProject.
+ 
+ 	manifestDict at: #URI ifPresent: [:aUri | self projectParameterAt: #URI put: aUri].
+ 	manifestDict at: #user ifPresent: [:aUser | self projectParameterAt: #user put: aUser].
+ 	manifestDict at: #'prev-URI' ifPresent: [:aUri | self projectParameterAt: #'prev-URI' put: aUri]!

Item was added:
+ ----- Method: Project>>okToChangeSilently (in category '*Etoys-Squeakland-release') -----
+ okToChangeSilently
+ 	"Answer whether the window in which the project is housed can be dismissed -- which is destructive. We never clobber a project without confirmation"
+ 
+ 	| ok is list |
+ 	self subProjects size > 0 ifTrue:
+ 		[^ false].
+ 	ok _ world isMorph not and: [world scheduledControllers size <= 1].
+ 	ok ifFalse: [self isMorphic ifTrue:
+ 		[self parent == CurrentProject 
+ 			ifFalse: [^ true]]].  "view from elsewhere.  just delete it."
+ 	ok _ true.
+ 	ok ifFalse: [^ false].
+ 
+ 	world isMorph ifTrue:
+ 		[Smalltalk at: #WonderlandCameraMorph ifPresent:[:aClass |
+ 			world submorphs do:   "special release for wonderlands"
+ 						[:m | (m isKindOf: aClass)
+ 								and: [m getWonderland release]]].
+ 			"Remove Player classes and metaclasses owned by project"
+ 			is _ ImageSegment new arrayOfRoots: (Array with: self).
+ 			(list _ is rootsIncludingPlayers) ifNotNil:
+ 				[list do: [:playerCls | 
+ 					(playerCls respondsTo: #isMeta) ifTrue:
+ 						[playerCls isMeta ifFalse:
+ 							[playerCls removeFromSystemUnlogged]]]]].
+ 
+ 	self removeChangeSetIfPossible.
+ 	"do this last since it will render project inaccessible to #allProjects and their ilk"
+ 	ProjectHistory forget: self.
+ 	Project deletingProject: self.
+ 	^ true
+ !

Item was added:
+ ----- Method: Project>>storeOnServerWithNoInteraction (in category '*Etoys-Squeakland-file in/out') -----
+ storeOnServerWithNoInteraction
+ 
+ 	"Save to disk as an Export Segment.  Then put that file on the server I came from, as a new version.  Version is literal piece of file name.  Mime encoded and http encoded."
+ 	| ret pp |
+ 	world setProperty: #optimumExtentFromAuthor toValue: world extent.
+ 	self isCurrentProject ifTrue: ["exit, then do the command"
+ 		Flaps globalFlapTabsIfAny do: [:each | Flaps removeFlapTab: each keepInList: true].
+ 		ret _ self 
+ 			armsLengthCommand: #storeOnServerWithNoInteraction
+ 			withDescription: 'Publishing' translated.
+ 		^ ret
+ 	].
+ 	pp _   self displaySavingProgress.
+ 	[self storeOnServerWithNoInteractionInnards] on: Error do: [:ex |
+ 		Smalltalk logError: ex description inContext: ex signalerContext to: 'SqueakDebug.log'.
+ 		pp value. ^ false].
+ 	pp value.
+ 	^ true.
+ !

Item was added:
+ ----- Method: Project>>storeOnServerWithNoInteractionInnards (in category '*Etoys-Squeakland-file in/out') -----
+ storeOnServerWithNoInteractionInnards
+ 	"Save to disk as an Export Segment.  Then put that file on the server I came from, as a new version.  Version is literal piece of file name.  Mime encoded and http encoded."
+ 
+ 	| newName primaryServerDirectory serverVersionPair localDirectory localVersionPair myVersionNumber warning maxNumber priorWorld myDepth |
+ 	self assureIntegerVersion.
+ 
+ 	"Find out what version"
+ 	primaryServerDirectory _ self defaultFolderForAutoSaving ifNil: [^self].
+ 
+ 	localDirectory _ self squeakletDirectory.
+ 	serverVersionPair _ self class mostRecent: self name onServer: primaryServerDirectory.
+ 	localVersionPair _ self class mostRecent: self name onServer: localDirectory.
+ 	maxNumber _ myVersionNumber _ self currentVersionNumber.
+ 
+ 	ProgressNotification signal: '2:versionsDetected'.
+ 
+ 	warning _ ''.
+ 	myVersionNumber < serverVersionPair second ifTrue: [
+ 		warning _ warning,'\There are newer version(s) on the server' translated.
+ 		maxNumber _ maxNumber max: serverVersionPair second.
+ 	].
+ 	myVersionNumber < localVersionPair second ifTrue: [
+ 		warning _ warning,'\There are newer version(s) in the local directory' translated.
+ 		maxNumber _ maxNumber max: localVersionPair second.
+ 	].
+ 	version _ self bumpVersion: maxNumber.
+ 
+ 	"write locally - now zipped automatically"
+ 	Display isVirtualScreen ifTrue: [
+ 		myDepth _ displayDepth.
+ 		displayDepth _ OLPCVirtualScreen preferredScreenDepth..
+ 	].
+ 	newName _ self versionedFileName.
+ 	lastSavedAtSeconds _ Time totalSeconds.
+ 	priorWorld _ ActiveWorld.
+ 	self exportSegmentFileName: newName directory: localDirectory withoutInteraction: true.
+ 	ActiveWorld _ priorWorld.
+ 	(localDirectory readOnlyFileNamed: newName) setFileTypeToObject; close.
+ 	Display isVirtualScreen ifTrue: [
+ 		displayDepth _ myDepth.
+ 	].
+ 	
+ 	ProgressNotification signal: '4:localSaveComplete'.	"3 is deep in export logic"
+ 
+ 	primaryServerDirectory ifNotNil: [
+ 		[
+ 		primaryServerDirectory
+ 			writeProject: self
+ 			inFileNamed: newName asFileName
+ 			fromDirectory: localDirectory.
+ 		] on: ProjectPasswordNotification do: [ :ex |
+ 			ex resume: ''
+ 		].
+ 	].
+ 	ProgressNotification signal: '9999 save complete'.
+ !

Item was added:
+ ----- Method: Project>>storeOnServerWithNoInteractionThenQuit (in category '*Etoys-Squeakland-file in/out') -----
+ storeOnServerWithNoInteractionThenQuit
+ 
+ 	"Save to disk as an Export Segment.  Then put that file on the server I came from, as a new version.  Version is literal piece of file name.  Mime encoded and http encoded. Then Quit"
+ 	| ret pp |
+ 	world setProperty: #optimumExtentFromAuthor toValue: world extent.
+ 	self isCurrentProject ifTrue: ["exit, then do the command"
+ 		Flaps globalFlapTabsIfAny do: [:each | Flaps removeFlapTab: each keepInList: true].
+ 		ret _ self 
+ 			armsLengthCommand: #storeOnServerWithNoInteractionThenQuit
+ 			withDescription: 'Publishing' translated.
+ 		^ ret
+ 	].
+ 	pp _   self displaySavingProgress.
+ 	[[self storeOnServerWithNoInteractionInnards]
+ 		on: Error do: [:ex |
+ 			Smalltalk logError: ex description
+ 				inContext: ex signalerContext
+ 				to: 'SqueakDebug.log']
+ 	] ensure: [pp value. Smalltalk quitPrimitive].
+ 	^ true.
+ !

Item was added:
+ ----- Method: Project>>storePngThumbnailIn: (in category '*Etoys-Squeakland-file in/out') -----
+ storePngThumbnailIn: aFileDirectory
+ 	"Make an icon representing the receiver, and store it in the given directory."
+ 
+ 	| file writer |
+ 	file _ aFileDirectory forceNewFileNamed: ('thumbnail', FileDirectory dot, 'png').
+ 	file ifNil: [^ self].
+ 	writer := PNGReadWriter on: file.
+ 	[writer nextPutImage: self thumbnail]	
+ 		ensure: [writer close]!

Item was added:
+ ----- Method: Project>>sugarObjectId (in category '*Etoys-Squeakland-sugar') -----
+ sugarObjectId
+ 	^((self sugarProperties ifNil: [^nil])
+ 		at: 'uid' ifAbsent: [nil]) asString!

Item was added:
+ ----- Method: Project>>sugarObjectId: (in category '*Etoys-Squeakland-sugar') -----
+ sugarObjectId: aStringOrNil
+ 	| props |
+ 	props := self sugarProperties ifNil: [self sugarProperties: Dictionary new].
+ 	aStringOrNil
+ 		ifNil: [props removeKey: 'uid' ifAbsent: []]
+ 		ifNotNil: [props at: 'uid' put: aStringOrNil]!

Item was added:
+ ----- Method: Project>>sugarProperties (in category '*Etoys-Squeakland-sugar') -----
+ sugarProperties
+ 	^self projectParameterAt: #sugarProperties ifAbsent: [nil]!

Item was added:
+ ----- Method: Project>>sugarProperties: (in category '*Etoys-Squeakland-sugar') -----
+ sugarProperties: aDictionary
+ 	^self projectParameterAt: #sugarProperties put: aDictionary!

Item was added:
+ ----- Method: Project>>toggleUseLocale (in category '*Etoys-Squeakland-language') -----
+ toggleUseLocale
+ 	
+ ^Preferences togglePreference: #useLocale
+ 	
+ 
+ 
+ 
+ !

Item was added:
+ ----- Method: Project>>updateLocaleDependentsGently (in category '*Etoys-Squeakland-language') -----
+ updateLocaleDependentsGently
+ 
+ 	| supplies prev |
+ 	prev _ Locale previous ifNotNil: [Locale previous localeID] ifNil: [LocaleID isoString: 'en'].
+ 	supplies _ Flaps globalFlapTabWithID: ('Supplies' translatedTo: prev). 
+ 	supplies ifNotNil: [supplies _ supplies referent submorphs].
+ 
+ 	^ self updateLocaleDependentsWithPreviousSupplies: supplies gently: true.
+ !

Item was added:
+ ----- Method: Project>>updateLocaleDependentsWithPreviousSupplies:gently: (in category '*Etoys-Squeakland-language') -----
+ updateLocaleDependentsWithPreviousSupplies: aCollection gently: gentlyFlag
+ 	"Set the project's natural language as indicated"
+ 
+ 	| morphs scriptEditors |
+ 	gentlyFlag ifTrue: [
+ 		LanguageEnvironment localeChangedGently.
+ 	] ifFalse: [
+ 		LanguageEnvironment localeChanged.
+ 	].
+ 
+ 	morphs := IdentitySet new: 400.
+ 	ActiveWorld allMorphsAndBookPagesInto: morphs.
+ 	scriptEditors := morphs select: [:m | (m isKindOf: ScriptEditorMorph) and: [m topEditor == m]].
+ 	(morphs copyWithoutAll: scriptEditors) do: [:morph | morph localeChanged].
+ 	scriptEditors do: [:m | m localeChanged].
+ 
+ 	Flaps disableGlobalFlaps: false.
+ 	SugarNavigatorBar showSugarNavigator
+ 		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.
+ 
+ 	#(PartsBin ParagraphEditor BitEditor FormEditor StandardSystemController) 
+ 		do: [ :key | Smalltalk at: key ifPresent: [ :class | class initialize ]].
+ 
+ 	ActiveWorld reformulateUpdatingMenus.
+ 	"self setFlaps.
+ 	self setPaletteFor: aLanguageSymbol."
+ !

Item was added:
+ ----- Method: Project>>useLocaleString (in category '*Etoys-Squeakland-language') -----
+ useLocaleString
+ 	"Answer a string characterizing whether the receiver is currently using localized language."
+ 
+ 	^ (Preferences useLocale == true ifTrue: ['<yes>'] ifFalse: ['<no>']), ('use localized language' translated)!

Item was added:
+ ----- Method: Project>>version: (in category '*Etoys-Squeakland-file in/out') -----
+ version: anInteger
+ 
+ 	version _ anInteger.
+ !

Item was added:
+ ----- Method: Project>>writeForExportInSexp:withSources:inDirectory:changeSet: (in category '*Etoys-Squeakland-file in/out') -----
+ writeForExportInSexp: sexp withSources: actualName inDirectory: aDirectory changeSet:
+ aChangeSetOrNil
+ 
+ 	| fileStream tempFileName zipper d |
+ 
+ 	tempFileName _ aDirectory nextNameFor: 'SqProject' extension: 'temp'.
+ 	zipper _ [
+ 		aDirectory rename: tempFileName toBe: actualName.
+ 		aDirectory deleteFileNamed: tempFileName ifAbsent: []
+ 	].
+ 	fileStream _ aDirectory newFileNamed: tempFileName.
+ 	d _ DataStream on: (WriteStream on: (ByteArray new: sexp elements size * 50)).
+ 	d nextPut: sexp.
+ 	fileStream binary.
+ 	fileStream nextPutAll: d contents.
+ 	fileStream close.
+ 	fileStream _ aDirectory newFileNamed: 'changes.cs'.
+ 	aChangeSetOrNil ifNotNil: [aChangeSetOrNil fileOutOn: fileStream].
+ 	fileStream close.
+ 
+ 	zipper value.
+ !

Item was added:
+ ----- Method: ProjectLauncher>>setupMOPath (in category '*Etoys-Squeakland-initialization') -----
+ setupMOPath
+ 	(self includesParameter: 'MO_PATH')
+ 		ifTrue: [GetTextTranslator addSystemDefaultLocaleDir: (self parameterAt: 'MO_PATH')].
+ !

Item was added:
+ ----- Method: ProjectLoading class>>enterWelcomeProject (in category '*Etoys-Squeakland-public') -----
+ enterWelcomeProject
+ 	"self new enterWelcomeProject"
+ 	| userDirectory entries |
+ 	"If there is user projects."
+ 	userDirectory := FileDirectory on: SecurityManager default untrustedUserDirectory.
+ 	entries := FileList2 projectOnlySelectionMethod: userDirectory entries.
+ 	entries isEmpty
+ 		ifFalse: [^ self].
+ 	"If welcome project is already loaded."
+ 	ProjectLoading openFromImagePath: 'Welcome'!

Item was added:
+ ----- Method: ProjectLoading class>>loadFromDir:projectName: (in category '*Etoys-Squeakland-public') -----
+ loadFromDir: dirName projectName: projectName 
+ 	"Open the project in image path. This is used with projects in OLPC distribution.
+ 	- The image's directory is used.
+ 	- Squeaklets directory is ignored.
+ 	- If there is a project named projectName, it is opened.
+ 	"
+ 	"self openFromImagePath: 'Welcome'"
+ 	| directory aStream entries fileName |
+ 	(Project named: projectName)
+ 		ifNotNilDo: [:project | ^ project].
+ 	directory := FileDirectory on: dirName.
+ 	entries := FileList2 projectOnlySelectionMethod: directory entries.
+ 	entries := entries
+ 				detect: [:each | (Project parseProjectFileName: each first) first = projectName] ifNone: [^ self].
+ 	fileName := entries first.
+ 	self
+ 		showProgressBarDuring: [ProgressNotification signal: '0'.
+ 			aStream := directory readOnlyFileNamed: fileName.
+ 			self
+ 				loadName: fileName
+ 				stream: aStream
+ 				fromDirectory: directory
+ 				withProjectView: nil]!

Item was added:
+ ----- Method: ProjectLoading class>>loadSexpProjectDict:stream:fromDirectory:withProjectView: (in category '*Etoys-Squeakland-private') -----
+ loadSexpProjectDict: dict stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView
+ 
+    	| archive anObject newProj d member b s memberStream members newSet allNames realName oldSet |
+ 	(self checkStream: preStream) ifTrue: [^ self].
+ 	ProgressNotification signal: '0.2'.
+ 	preStream reset.
+ 	archive _ preStream isZipArchive
+ 		ifTrue:[ZipArchive new readFrom: preStream]
+ 		ifFalse:[nil].
+ 
+ 	members _ archive  membersMatching: '*.cs'.
+ 	members do: [:e | newSet _ ChangeSorter newChangesFromStream: e contentStream named: 'zzTemp', Time totalSeconds printString].
+ 
+ 	member _ (archive membersMatching: '*.sexp') first.
+ 	memberStream _ member contentStream.
+ 	(self checkSecurity: member name preStream: preStream projStream: memberStream)
+ 		ifFalse: [^nil].
+ 	b _ String new: member uncompressedSize.
+ 	s _ RWBinaryOrTextStream on: b.
+ 	s binary.
+ 	s nextPutAll: memberStream basicUpToEnd.
+ 	s reset.
+ 	d _ DataStream on: s.
+ 	anObject _ d next sissReadObjectsAsEtoysProject.
+ 
+ 	"anObject _ (MSExpParser parse: (archive membersMatching: '*.sexp') first contents with: #ksexp) sissReadObjects."
+ 	anObject ifNil: [^ self].
+ 	(anObject isKindOf: PasteUpMorph) ifFalse: [^ World addMorph: anObject].
+ 	preStream close.
+ 	ProgressNotification  signal: '0.7'.
+ 	newProj _ Project newMorphicOn: anObject.
+ 	newSet ifNotNil: [oldSet _ newProj changeSet.  newProj setChangeSet: newSet. ChangeSorter removeChangeSet: oldSet].
+ 	dict at: 'projectname' ifPresent: [:n |
+ 		allNames _ Project allNames.
+ 		realName _ Utilities keyLike: n  satisfying:
+ 		[:nn | (allNames includes: nn) not].
+ 		newProj renameTo: realName.
+ 	].
+ 	anObject valueOfProperty: #projectVersion ifPresentDo: [:v | newProj version: v].
+ 	newProj  noteManifestDetailsIn: dict.
+ 	ProgressNotification  signal: '0.8'.
+ 	^ newProj.
+ !

Item was added:
+ ----- Method: ProjectLoading class>>loadSqueakPage: (in category '*Etoys-Squeakland-private') -----
+ loadSqueakPage: morphOrList
+ 	| contentsMorph |
+ 	contentsMorph _  (morphOrList isKindOf: SqueakPage)
+ 		ifTrue: [morphOrList contentsMorph]
+ 		ifFalse: [morphOrList].
+ 	(contentsMorph isKindOf: PasteUpMorph) ifFalse:
+ 		[^ self inform: 'This is not a PasteUpMorph or
+ exported Project.' translated].
+ 	(Project newMorphicOn: contentsMorph) enter
+ !

Item was added:
+ ----- Method: ProjectLoading class>>openFromImagePath: (in category '*Etoys-Squeakland-public') -----
+ openFromImagePath: projectName 
+ 	"Open the project in image path. This is used with projects in OLPC distribution.
+ 	- The image's directory is used.
+ 	- Squeaklets directory is ignored.
+ 	- If there is a project named projectName, it is opened.
+ 	"
+ 	"self openFromImagePath: 'Welcome'"
+ 	| directory aStream entries fileName |
+ 	(Project named: projectName)
+ 		ifNotNilDo: [:project | ^ project enter].
+ 	directory := FileDirectory on: Smalltalk imagePath.
+ 	entries := FileList2 projectOnlySelectionMethod: directory entries.
+ 	entries := entries
+ 				detect: [:each | (Project parseProjectFileName: each first) first = projectName] ifNone: [^ self].
+ 	fileName := entries first.
+ 	self
+ 		showProgressBarDuring: [ProgressNotification signal: '0'.
+ 			directory := FileDirectory on: Smalltalk imagePath.
+ 			aStream := directory readOnlyFileNamed: fileName.
+ 			self
+ 				openName: fileName
+ 				stream: aStream
+ 				fromDirectory: directory
+ 				withProjectView: nil]!

Item was added:
+ ----- Method: ProjectLoading class>>openName:stream:fromDirectory:withProjectView:clearOriginFlag: (in category '*Etoys-Squeakland-public') -----
+ openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil
+ withProjectView: existingView clearOriginFlag: clearOriginFlag
+ 	"Reconstitute a Morph from the selected file, presumed to
+ represent a Morph saved via the SmartRefStream mechanism, and open it
+ in an appropriate Morphic world."
+ 
+    	| morphOrList archive mgr substituteFont numberOfFontSubstitutes resultArray anObject project manifests dict |
+ 	(self checkStream: preStream) ifTrue: [^ self].
+ 	ProgressNotification signal: '0.2'.
+ 	archive _ preStream isZipArchive
+ 		ifTrue:[ZipArchive new readFrom: preStream]
+ 		ifFalse:[nil].
+ 	archive ifNotNil:[
+ 	manifests _ (archive membersMatching: '*manifest').
+ 	(manifests size = 1 and: [((dict _ self parseManifest: manifests first contents) at: 'Project-Format' ifAbsent: []) = 'S-Expression'])
+ 		ifTrue: [^ self openSexpProjectDict: dict stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView]].
+ 
+ 	morphOrList _ self morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive.
+ 	morphOrList ifNil: [^ self].
+ 	ProgressNotification  signal: '0.4'.
+ 	resultArray _ self fileInName: aFileName archive: archive morphOrList: morphOrList.
+ 	anObject _ resultArray first.
+ 	numberOfFontSubstitutes _ resultArray second.
+ 	substituteFont _ resultArray third.
+ 	mgr _ resultArray fourth.
+ 	preStream close.
+ 	ProgressNotification  signal: '0.7'.
+ 		"the hard part is over"
+ 	(anObject isKindOf: ImageSegment) ifTrue: [
+ 		project _ self loadImageSegment: anObject
+ 			fromDirectory: aDirectoryOrNil
+ 			withProjectView: existingView
+ 			numberOfFontSubstitutes: numberOfFontSubstitutes
+ 			substituteFont: substituteFont
+ 			mgr: mgr.].
+ 	(anObject isKindOf: ImageSegment) ifTrue: [
+ 		project noteManifestDetailsIn: dict.
+ 		project removeParameter: #sugarProperties.
+ 		SugarPropertiesNotification signal ifNotNilDo: [:props | 
+ 			project keepSugarProperties: props monitor: true].
+ 		clearOriginFlag ifTrue: [project forgetExistingURL].
+ 		ProgressNotification  signal: '0.8'.
+ 			^ project
+ 				ifNil: [self inform: 'No project found in this file' translated]
+ 				ifNotNil: [ProjectEntryNotification signal: project]].
+ 	self loadSqueakPage: anObject!

Item was added:
+ ----- Method: ProjectLoading class>>openOn: (in category '*Etoys-Squeakland-public') -----
+ openOn: aStream 
+ 	self
+ 		showProgressBarDuring: [self
+ 				openName: nil
+ 				stream: aStream
+ 				fromDirectory: nil
+ 				withProjectView: nil]!

Item was added:
+ ----- Method: ProjectLoading class>>openSexpProjectDict:stream:fromDirectory:withProjectView: (in category '*Etoys-Squeakland-private') -----
+ openSexpProjectDict: dict stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView
+ 
+    	| archive anObject newProj d member b s memberStream members newSet allNames realName oldSet |
+ 	(self checkStream: preStream) ifTrue: [^ self].
+ 	ProgressNotification signal: '0.2'.
+ 	preStream reset.
+ 	archive _ preStream isZipArchive
+ 		ifTrue:[ZipArchive new readFrom: preStream]
+ 		ifFalse:[nil].
+ 
+ 	members _ archive  membersMatching: '*.cs'.
+ 	members do: [:e | newSet _ ChangeSorter newChangesFromStream: e contentStream named: 'zzTemp', Time totalSeconds printString].
+ 
+ 	member _ (archive membersMatching: '*.sexp') first.
+ 	memberStream _ member contentStream.
+ 	(self checkSecurity: member name preStream: preStream projStream: memberStream)
+ 		ifFalse: [^nil].
+ 	b _ String new: member uncompressedSize.
+ 	s _ RWBinaryOrTextStream on: b.
+ 	s binary.
+ 	s nextPutAll: memberStream basicUpToEnd.
+ 	s reset.
+ 	d _ DataStream on: s.
+ 	anObject _ d next sissReadObjectsAsEtoysProject.
+ 
+ 	"anObject _ (MSExpParser parse: (archive membersMatching: '*.sexp') first contents with: #ksexp) sissReadObjects."
+ 	anObject ifNil: [^ self].
+ 	(anObject isKindOf: PasteUpMorph) ifFalse: [^ World addMorph: anObject].
+ 	preStream close.
+ 	ProgressNotification  signal: '0.7'.
+ 	newProj _ Project newMorphicOn: anObject.
+ 	newSet ifNotNil: [oldSet _ newProj changeSet.  newProj setChangeSet: newSet. ChangeSorter removeChangeSet: oldSet].
+ 	dict at: 'projectname' ifPresent: [:n |
+ 		allNames _ Project allNames.
+ 		realName _ Utilities keyLike: n  satisfying:
+ 		[:nn | (allNames includes: nn) not].
+ 		newProj renameTo: realName.
+ 	].
+ 	anObject valueOfProperty: #projectVersion ifPresentDo: [:v | newProj version: v].
+ 	newProj  noteManifestDetailsIn: dict.
+ 	ProgressNotification  signal: '0.8'.
+ 	^ newProj
+ 		ifNil: [self inform: 'No project found in this file' translated]
+ 		ifNotNil: [ProjectEntryNotification signal: newProj].
+ !

Item was added:
+ ----- Method: ProjectLoading class>>worldLoading (in category '*Etoys-Squeakland-public') -----
+ worldLoading
+ 
+ 	^ worldLoading.
+ !

Item was added:
+ ----- Method: ProjectLoading class>>worldLoading: (in category '*Etoys-Squeakland-public') -----
+ worldLoading: aWorld
+ 
+ 	worldLoading _ aWorld.
+ !

Item was added:
+ ----- Method: ProjectNavigationMorph>>buttonHelp (in category '*Etoys-Squeakland-the buttons') -----
+ buttonHelp
+ 	"Answer a button for toggling the help flap open and closed"
+ 
+ 	^ self makeButton: 'Help' translated balloonText: 'Help' translated for: #toggleHelp!

Item was added:
+ ----- Method: ProjectNavigationMorph>>buttonSupplies (in category '*Etoys-Squeakland-the buttons') -----
+ buttonSupplies
+ 	"Answer a button for toggling the supplies flap open and closed"
+ 
+ 	^ self makeButton: 'Supplies' translated balloonText: 'Supplies' translated for: #toggleSupplies!

Item was added:
+ ----- Method: ProjectNavigationMorph>>colorForSoundKnob (in category '*Etoys-Squeakland-as yet unclassified') -----
+ colorForSoundKnob
+ 	"Answer the color to be used on the draggable knob of the Sound Slider in the nav-bar."
+ 
+ 	^ Color black!

Item was added:
+ ----- Method: ProjectNavigationMorph>>doStopButtonMenuEvent: (in category '*Etoys-Squeakland-the actions') -----
+ doStopButtonMenuEvent: evt
+ 
+ 	| menu selection |
+ 
+ 	menu _ CustomMenu new.
+ 	menu 
+ 		add: 'stop Etoys' translated action: [self stopSqueak];
+ 		add: 'quit without saving' translated action: [SmalltalkImage current snapshot: false andQuit: true].
+ 
+ 	selection _ menu build startUpCenteredWithCaption: 'Stop options' translated.
+ 	selection ifNil: [^self].
+ 	selection value.
+ 
+ !

Item was added:
+ ----- Method: ProjectNavigationMorph>>toggleFullScreen (in category '*Etoys-Squeakland-the actions') -----
+ toggleFullScreen
+ 	"Toggle the setting of fullScreen"
+ 
+ 	self inFullScreenMode ifTrue: [self fullScreenOff] ifFalse: [self fullScreenOn]!

Item was added:
+ ----- Method: ProjectSorterMorph>>handUserSorterMorphForProjectNamed: (in category '*Etoys-Squeakland-menu commands') -----
+ handUserSorterMorphForProjectNamed: aName
+ 	"Hand the user a sorter token representing the project of the given name."
+ 
+ 	(self sorterMorphForProjectNamed: aName) openInHand!

Item was added:
+ ----- Method: ProjectView>>cacheBitsAsTwoTone (in category '*Etoys-Squeakland-displaying') -----
+ cacheBitsAsTwoTone
+ 	^ false!

Item was added:
+ ----- Method: ProjectViewMorph>>clearStringMorph (in category '*Etoys-Squeakland-accessing') -----
+ clearStringMorph
+ 
+ 	string := nil
+ !

Item was added:
+ PrintableEncoder subclass: #PropertyListEncoder
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-MorphicExtras-Postscript Filters'!

Item was added:
+ ----- Method: PropertyListEncoder class>>filterSelector (in category 'configuring') -----
+ filterSelector
+ 	^#propertyListOn:.
+ !

Item was added:
+ ----- Method: PropertyListEncoder>>writeArrayedCollection: (in category 'writing') -----
+ writeArrayedCollection:aCollection
+ 	self print:'/* '; print:aCollection class name; print:'*/'; cr.
+ 	self print:'( '; writeCollectionContents:aCollection separator:','; print:')'.!

Item was added:
+ ----- Method: PropertyListEncoder>>writeDictionary: (in category 'writing') -----
+ writeDictionary:aCollection
+ 	self print:'{ '; writeDictionaryContents:aCollection separator:'; '; print:'}'.!

Item was added:
+ ProtoObject variableSubclass: #PseudoContext
+ 	instanceVariableNames: 'fixed fields never accessed from smalltalk'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Kernel-Methods'!
+ 
+ !PseudoContext commentStamp: '<historical>' prior: 0!
+ I represent cached context state within the virtual machine.  I have the same format as normal method and block contexts, but my fields are never referenced directly from Smalltalk.  Whenever a message is sent to me I will magically transform myself into a real context which will respond to all the usual messages.
+ 	I rely on the fact that block and method contexts have exactly the same number of fixed fields.!

Item was added:
+ ----- Method: PseudoContext class>>contextCacheDepth (in category 'private') -----
+ contextCacheDepth
+ 	"Answer the number of entries in the context cache.  This requires a little insider
+ 	knowledge.  Not intended for casual use, which is why it's private protocol."
+ 
+ 	^self contextCacheDepth: thisContext yourself!

Item was added:
+ ----- Method: PseudoContext class>>contextCacheDepth: (in category 'private') -----
+ contextCacheDepth: b
+ 	^b isPseudoContext
+ 		ifTrue: [1 + (self contextCacheDepth: b)]
+ 		ifFalse: [1]!

Item was added:
+ ----- Method: PseudoContext class>>definition (in category 'filing out') -----
+ definition
+ 	"Our superclass is really nil, but this causes problems when we try to become compact
+ 	after filing in for the first time.  Fake the superclass as Object, and repair the situation
+ 	during class initialisation."
+ 	| defn |
+ 	defn _ super definition.
+ 	^(defn beginsWith: 'nil ')
+ 		ifTrue: ['Object' , (defn copyFrom: 4 to: defn size)]
+ 		ifFalse: [defn].!

Item was added:
+ ----- Method: PseudoContext>>isPseudoContext (in category 'testing') -----
+ isPseudoContext
+ 	^true!

Item was added:
+ ----- Method: PseudoContext>>nextObject (in category 'system primitives') -----
+ nextObject
+ 	"See Object>>nextObject."
+ 
+ 	<primitive: 139>
+ 	self primitiveFailed.!

Item was added:
+ Object subclass: #PseudoPoolVariable
+ 	instanceVariableNames: 'name getterBlock setterBlock'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Kernel-Contexts'!
+ 
+ !PseudoPoolVariable commentStamp: '<historical>' prior: 0!
+ The values of pool and global variables (traditionally Associations) are fetched by sending #poolValue and set by sending #setInPool: which send #poolValue:.  These sends are automatically added in by the Compiler (see PoolVarNode {code generation}).  So any object can act like a pool variable.  This class allows getter and setter blocks for poolValue and poolValue:.!

Item was added:
+ ----- Method: PseudoPoolVariable>>canAssign (in category 'as yet unclassified') -----
+ canAssign
+ 
+ 	^ setterBlock notNil!

Item was added:
+ ----- Method: PseudoPoolVariable>>getter: (in category 'as yet unclassified') -----
+ getter: block
+ 
+ 	getterBlock _ block!

Item was added:
+ ----- Method: PseudoPoolVariable>>name (in category 'as yet unclassified') -----
+ name
+ 
+ 	^ name!

Item was added:
+ ----- Method: PseudoPoolVariable>>name: (in category 'as yet unclassified') -----
+ name: string
+ 
+ 	name _ string!

Item was added:
+ ----- Method: PseudoPoolVariable>>setter: (in category 'as yet unclassified') -----
+ setter: block
+ 
+ 	setterBlock _ block!

Item was added:
+ ----- Method: PseudoPoolVariable>>value (in category 'as yet unclassified') -----
+ value
+ 
+ 	^ getterBlock value!

Item was added:
+ ----- Method: PseudoPoolVariable>>value: (in category 'as yet unclassified') -----
+ value: obj
+ 
+ 	setterBlock value: obj!

Item was added:
+ Morph subclass: #QuickGuideGenerator
+ 	instanceVariableNames: 'input output inputMorph outputMorph fileList'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Books'!
+ 
+ !QuickGuideGenerator commentStamp: 'tk 1/3/2008 10:32' prior: 0!
+ Used to generate .sexp files for the Quick Guides.  These are the help system for Etoys.  
+ How to use:
+ Pressing the Help button [?] at the top left of the screen, brings up the QuickGuides flap.  The index page has categories of help.  The Jump To... button allows you to get to any help guide.  
+ To create a new guide, copy the bookmorph out of the flap.  Use the halos to completely change the contents.  Create help pages for a new topic.  
+ When you are done, write the entire project out using "Keep the current project".  It is now a .pr file.
+ If you put the .pr into the QuickGuides folder, you will be able to see it in the Help flap.  (Click the Help button [?] once to close help, and once again to open it.)
+ You can test a .pr file in the QuickGuides folder, but it is not in the proper format to include in the OLPC build.
+ The purpose of QuickGuideGenerator is to put a guide in to the proper format for distribution.  
+ 0) Get the new Guides from  http://tinlizzie.org/quickguides
+ 1) Make a folder called "To-Be-Translated" at the top level of your file system.  Put the .pr files of all new guides into this folder.
+ 1.5) Make a folder called "Newer" in the folder that has the Etoys image file.  Must be a fresh new folder.
+ 2) Start Etoys.  You will NOT save this image.
+ 3) Execute
+ 	QuickGuideGenerator new openInWorld.
+ 4) Wait until a new window appears.
+ 5) Find the folder "To-Be-Translated" in the list and click on it.  It's path will appear in the top pane.
+ 6) Press the "Generate" button. Wait.
+ 7) Quit Etoys.
+ 8) "Newer" will now have a .sexp file for each guide that was a .pr file.   Files ending in .sexp contain Yoshiki's S-expression linearization of object trees.
+ 9) Copy the .sexp files to QuickGuides, and delete the .pr files of the same name.
+ 10) Rename Newer to be Newer-day-month-year
+ 11) Copy Newer-xx to http://tinlizzie.org/share/QG-compressed
+ 12) copy the .sexp files into http://tinlizzie.org/share/QG-compressed/Quickguides
+ 
+ !

Item was added:
+ ----- Method: QuickGuideGenerator>>currentDirectorySelected (in category 'all') -----
+ currentDirectorySelected
+ 
+ 	^ fileList currentDirectorySelected.
+ !

Item was added:
+ ----- Method: QuickGuideGenerator>>generate (in category 'all') -----
+ generate
+ 
+ 	| inDir outDir |
+ 	inDir _ FileDirectory on: input.
+ 	inDir fileNames ifEmpty: [
+ 		self inform: 'the input path doesn''t point to\the directory with projects' withCRs. ^ self].
+ 	outDir _ FileDirectory on: output.
+ 	outDir assureExistence.
+ 	outDir fileNames ifNotEmpty: [
+ 		"self halt.	let me see what is in it!!"
+ 		self inform: 'output directory is not empty.\Please remove files in it first.' withCRs. ^ self].
+ 
+ 	QuickGuideMorph convertProjectsWithBooksToSISSIn: inDir to: outDir.
+ !

Item was added:
+ ----- Method: QuickGuideGenerator>>getInput (in category 'all') -----
+ getInput
+ 
+ 	^ input.
+ !

Item was added:
+ ----- Method: QuickGuideGenerator>>getOutput (in category 'all') -----
+ getOutput
+ 
+ 	^ output.
+ !

Item was added:
+ ----- Method: QuickGuideGenerator>>initialDirectoryList (in category 'all') -----
+ initialDirectoryList
+ 
+ 	^ fileList initialDirectoryList!

Item was added:
+ ----- Method: QuickGuideGenerator>>initialize (in category 'all') -----
+ initialize
+ 
+ 	super initialize.
+ 	input _ ''.
+ 	output _ (FileDirectory on: Smalltalk imagePath) fullPathFor: 'Newest'.
+ 	self setup.
+ !

Item was added:
+ ----- Method: QuickGuideGenerator>>makeInputDirList (in category 'all') -----
+ makeInputDirList
+ 
+ 	| m |
+ 	fileList _ FileList2 morphicView model.
+ 	fileList directory: (FileDirectory default).
+ 	m _ (SimpleHierarchicalListMorph 
+ 		on: self
+ 		list:  #initialDirectoryList
+ 		selected: #currentDirectorySelected
+ 		changeSelected: #setSelectedDirectoryTo:
+ 		menu: nil
+ 		keystroke: nil)
+ 			autoDeselect: false;
+ 			enableDrag: false;
+ 			enableDrop: true;
+ 			yourself.
+ 	m extent: m extent + (200 at 200).
+ 	^ m.
+ !

Item was added:
+ ----- Method: QuickGuideGenerator>>setInput: (in category 'all') -----
+ setInput: aString
+ 
+ 	input := aString asString.
+ 	(input endsWith: FileDirectory slash) ifTrue: [input _ input copyFrom: 1 to: input size - 1].
+ 	inputMorph hasUnacceptedEdits: false.
+ !

Item was added:
+ ----- Method: QuickGuideGenerator>>setOutput: (in category 'all') -----
+ setOutput: aString
+ 
+ 	output := aString asString.
+ 	(output endsWith: FileDirectory slash) ifTrue: [output _ output copyFrom: 1 to: output size - 1].
+ 	outputMorph hasUnacceptedEdits: false.
+ !

Item was added:
+ ----- Method: QuickGuideGenerator>>setSelectedDirectoryTo: (in category 'all') -----
+ setSelectedDirectoryTo: dir
+ 
+ 	input _ dir withoutListWrapper pathName.
+ 	fileList setSelectedDirectoryTo: dir.
+ 
+ 	self changed: #fileList.
+ 	self changed: #contents.
+ 	self changed: #currentDirectorySelected.
+ 	self changed: #getInput.
+ !

Item was added:
+ ----- Method: QuickGuideGenerator>>setup (in category 'all') -----
+ setup
+ 
+ 	| button |
+ 	self color: Color lightBlue.
+ 	self extent: 650 at 360.
+ 	self addMorph: self makeInputDirList.
+ 	inputMorph _ PluggableTextMorph on: self text: #getInput accept: #setInput:.
+ 	inputMorph acceptOnCR: true.
+ 	self addMorph: inputMorph.
+ 	inputMorph extent: 300 at 50.
+ 	inputMorph position: 355 at 0.
+ 
+ 	outputMorph _ PluggableTextMorph on: self text: #getOutput accept: #setOutput:.
+ 	outputMorph acceptOnCR: true.
+ 	outputMorph extent: 300 at 50.
+ 	outputMorph position: 355 at 50.
+ 	self addMorph: outputMorph.
+ 
+ 	button _ SimpleButtonMorph new.
+ 	button
+ 		labelString: 'Generate' font: Preferences standardMenuFont;
+ 		actionSelector: #generate;
+ 		arguments: #();
+ 		target: self.
+ 	button position: 365 at 125.
+ 	self addMorph: button.
+ 
+ 		!

Item was added:
+ PasteUpMorph subclass: #QuickGuideHolderMorph
+ 	instanceVariableNames: 'guideName guideNameInWords guideCategory'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Books'!
+ 
+ !QuickGuideHolderMorph commentStamp: 'tk 12/7/2007 15:08' prior: 0!
+ This is the Flap that holds the Guides.  Shows one guide at a time, !

Item was added:
+ ----- Method: QuickGuideHolderMorph>>guideCategory (in category 'accessing') -----
+ guideCategory
+ 	"Answer the value of guideCategory"
+ 
+ 	^ guideCategory!

Item was added:
+ ----- Method: QuickGuideHolderMorph>>guideCategory: (in category 'accessing') -----
+ guideCategory: anObject
+ 	"Set the value of guideCategory"
+ 
+ 	guideCategory _ anObject!

Item was added:
+ ----- Method: QuickGuideHolderMorph>>guideName (in category 'accessing') -----
+ guideName
+ 
+ 	^ guideName
+ !

Item was added:
+ ----- Method: QuickGuideHolderMorph>>guideName: (in category 'accessing') -----
+ guideName: aString
+ 
+ 	guideName _ aString.
+ 	self setNamePropertyTo: aString.
+ !

Item was added:
+ ----- Method: QuickGuideHolderMorph>>guideNameInWords (in category 'accessing') -----
+ guideNameInWords
+ 	"Answer the value of guideNameInWords"
+ 
+ 	^ guideNameInWords!

Item was added:
+ ----- Method: QuickGuideHolderMorph>>guideNameInWords: (in category 'accessing') -----
+ guideNameInWords: anObject
+ 	"Set the value of guideNameInWords"
+ 
+ 	guideNameInWords _ anObject!

Item was added:
+ ----- Method: QuickGuideHolderMorph>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	super initialize.
+ 	self setProperty: #quickGuideHolder toValue: true.
+ 	self beSticky.
+ !

Item was added:
+ ----- Method: QuickGuideHolderMorph>>load (in category 'file in/file out') -----
+ load
+ 	"If 'guide.00x.pr' is present, take the one with the largest x.  If only '.sexp.data.gz', then use it"
+ 	| dir m fileName f unzipped zipped ours proj tm |
+ 	self submorphs size > 0 ifTrue: [^ self].
+ 	dir _ FileDirectory on: QuickGuideMorph guidePath.
+ 	"#('xxx.001.pr' 'xxx.035.pr'  'xxx.sexp.data.gz') asSortedCollection   ('xxx.001.pr' 'xxx.035.pr' 'xxx.sexp.data.gz')"
+ 	ours _ dir fileNames select: [:fName | 
+ 		(fName beginsWith: guideName) and: [(fName endsWith: '.pr') or: [fName endsWith: '.sexp.data.gz']]].
+ 	ours _ ours asSortedCollection.
+ 	ours size = 0 ifTrue: [
+ 		submorphs size = 0 ifTrue: [
+ 			tm := TextMorph new contents: 'guide is missing' translated.
+ 			tm topLeft: self topLeft + (4 at 4).
+ 			self width: (self width max: 200).
+ 			self addMorphFront: tm].
+ 		^ self].
+ 	fileName _ ours size > 1 ifTrue: [ours at: (ours size - 1) "most recent .pr file"] ifFalse: [ours last "sexp"].
+ 	proj _ fileName endsWith: '.pr'.
+ 	Cursor wait showWhile: [
+ 		proj ifFalse: [
+ 			unzipped _ WriteStream on: ByteArray new.
+ 			f _ dir readOnlyFileNamed: fileName.
+ 			zipped _ GZipReadStream on: f.
+ 			unzipped nextPutAll: zipped contents.
+ 			m _ BookMorph bookFromPagesInSISSFormat: (DataStream on: (ReadStream on: (unzipped contents))) next.
+ 			f close].
+ 		proj ifTrue: [
+ 			m _ self loadPR: fileName dir: dir.
+ 			m ifNil: [^ self]].
+ 		m position: 0 at 0.
+ 		self position: 0 at 0.
+ 		self extent: m extent.
+ 		m setNamePropertyTo: guideName.
+ 		m beSticky.
+ 		self translateGuide: m.
+ 		self addMorph: m.
+ 	].
+ !

Item was added:
+ ----- Method: QuickGuideHolderMorph>>loadPR:dir: (in category 'file in/file out') -----
+ loadPR: fileName dir: dir
+ 	"load a guide from a .pr file"
+ 
+ 	| p book texts desc |
+ 	p _ ProjectLoading loadName: fileName 
+ 			stream: (dir readOnlyFileNamed: fileName) 
+ 			fromDirectory: dir withProjectView: #none.	"don't create project view"
+ 	book _ p world submorphs detect: [:b | b isMemberOf: BookMorph] ifNone: [nil].
+ 	book ifNotNil: [
+ 		texts _ book currentPage submorphs select: [:e | e isKindOf: TextMorph].
+ 		desc _ texts isEmpty
+ 			ifTrue: [^ nil]
+ 			ifFalse: [(texts asSortedCollection: [:x :y | x top < y top]) first contents asString].
+ "		Descriptions at: p name put: desc.
+ 		Thumbnails at: p name put: (book imageForm magnifyBy: 0.25).
+ 		Colors at: p name put: book color.
+ "
+ 		book hidePageControls.
+ 		].
+ 	^ book!

Item was added:
+ ----- Method: QuickGuideHolderMorph>>prepareToBeSaved (in category 'file in/file out') -----
+ prepareToBeSaved
+ 
+ 	self unload.
+ 	super prepareToBeSaved.
+ !

Item was added:
+ ----- Method: QuickGuideHolderMorph>>translateGuide: (in category 'file in/file out') -----
+ translateGuide: guideBook
+ 	"Look at the current language, and translate every string in the book.  Does change the book.  A new translation will happen every time the book is loaded from disk.  Version on the disk is the master in English."
+ 
+ 	true ifTrue: [^ self].	"turned off for now"
+ 
+ 	guideBook allMorphsDo: [:mm |
+ 		(mm isKindOf: TextMorph) ifTrue: [
+ 			mm wrapFlag: true.	"want wrap to bounds" "What if user does not want this?"
+ 			mm contents: mm contents string translated]].!

Item was added:
+ ----- Method: QuickGuideHolderMorph>>unload (in category 'file in/file out') -----
+ unload
+ 
+ 	self submorphs size = 0 ifTrue: [^ self].
+ 	(submorphs first isKindOf: BookMorph) ifTrue: [submorphs first deleteAlongWithPlayers].
+ 	2 to: submorphs size do: [:s | submorphs last delete].
+ !

Item was added:
+ BookMorph subclass: #QuickGuideMorph
+ 	instanceVariableNames: 'control order'
+ 	classVariableNames: 'Categories FileNameStems HTMLJumpTo IndexPage IndexPageMimeString PagesForCategory'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Books'!
+ 
+ !QuickGuideMorph commentStamp: 'tk 8/15/2010 14:18' prior: 0!
+ A BookMorph that holds QuickGuides.
+ 
+ World
+ an AlignmentMorph (the flap)
+ an AlignmentMorph
+ a QuickGuideMorph  (one page per guide, 54 pages.  
+ 		Page may be a stub if guide not in)
+ a QuickGuideHolderMorph
+ a BookMorph (4 pages)
+ a PasteUpMorph (a page)
+ 
+ QuickGuides are stored in Contents/Resources/QuickGuides/
+ or by language in Contents/Resources/locale/<id>/QuickGuides/
+ (see guidePath)
+ 
+ Categories = OrderedCollection of {catKey. catTitle}
+ 	where catKey appears at the start of a file name 'Menu'
+ 	catTitle may be UTF-8 full name.
+ PagesForCategory dictionary of (catKey -> list).  list has elements {guideName. guideTitle}.  guideName is last part of a file name and guideTitle may be in UTF-8.!

Item was added:
+ ----- Method: QuickGuideMorph class>>buildDefaultIndex (in category 'initialization') -----
+ buildDefaultIndex
+ 	| stems beg caps ind |
+ 	self fileNameStems.	"used by defaultOrderIn:"
+ 	Categories := OrderedCollection new.
+ 	self suggestedCategoryOrder 
+ 			do: [:cat | Categories add: {cat. cat}].
+ 	stems := FileNameStems.
+ 	stems do: [:fn | 
+ 		(self categoryOf: fn) = '' ifTrue: ["new"
+ 			"find first word"
+ 			caps := fn collect: [:char | 
+ 				char isUppercase ifTrue: [$c] ifFalse: [$l]].
+ 			caps at: 1 put: $l.
+ 			(ind := caps indexOf: $c) = 0 ifFalse: [
+ 				beg := fn copyFrom: 1 to: ind-1.
+ 				Categories add: {beg. beg}]]].
+ 	PagesForCategory := self defaultIndex.
+ !

Item was added:
+ ----- Method: QuickGuideMorph class>>categoryNamesDo: (in category 'initialization') -----
+ categoryNamesDo: aBlock
+ 	"go through the categories in order"
+ 
+ 	Categories do: [:catRec |
+ 		aBlock value: catRec first].!

Item was added:
+ ----- Method: QuickGuideMorph class>>categoryOf: (in category 'defaults') -----
+ categoryOf: aName
+ 
+ 	^ Categories detect: [:e | aName beginsWith: e first] ifNone: [''].
+ !

Item was added:
+ ----- Method: QuickGuideMorph class>>categoryTitleOf: (in category 'initialization') -----
+ categoryTitleOf: catName
+ 	|catTitle|
+ 	Categories do: [:catRec |
+ 		(catRec first = catName )  
+ 			ifTrue: [
+ 				catTitle := catRec second.
+ 				catTitle isNil ifTrue: [^catName]
+ 									ifFalse: [^catTitle].
+ 			].
+ 	].
+ 	^nil!

Item was added:
+ ----- Method: QuickGuideMorph class>>convertProjectsWithBooksToSISSIn:to: (in category 'initialization') -----
+ convertProjectsWithBooksToSISSIn: dir to: outDir
+ 
+ 	| p book |
+ 	dir fileNames do: [:f |
+ 		(f endsWith: '.pr') ifTrue: [
+ 			p _ ProjectLoading loadName: f stream: (dir readOnlyFileNamed: f) fromDirectory: dir withProjectView: nil.
+ 			book _ p world submorphs detect: [:b | b isMemberOf: BookMorph] ifNone: [nil].
+ 			book ifNotNil: [
+ 				book hidePageControls.
+ 				book storeAsDataStreamNamed: (outDir fullNameFor: (f copyUpTo: $.), '.sexp.data.gz').
+ 			].
+ 			p okToChangeSilently.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: QuickGuideMorph class>>defaultCatalog (in category 'initialization') -----
+ defaultCatalog
+ 	| catalog | 
+ 	catalog := Dictionary new.
+ 	self fileNameStems.	"used by defaultOrderIn:"
+ 	self suggestedCategoryOrder 
+ 			do: [:catKey| |articles|
+ 				articles := OrderedCollection new.
+ 				(self defaultOrderIn: catKey) 
+ 					do: [:guideName | | guideTitle |
+ 						guideTitle := self getWordyName: guideName forCategory: catKey.
+ 						articles add: {guideName. guideTitle}.
+ 					].
+ 				catalog at: catKey put: articles.
+ 			].
+ 	^catalog.!

Item was added:
+ ----- Method: QuickGuideMorph class>>defaultIndex (in category 'initialization') -----
+ defaultIndex
+ 	"Produce PagesForCategory.  Categories must already be initialized"
+ 	| index | 
+ 	index := Dictionary new.
+ 	self categoryNamesDo: [:catKey | |articles|
+ 				articles := OrderedCollection new.
+ 				(self defaultOrderIn: catKey) 
+ 					do: [:guideName | | guideTitle |
+ 						guideTitle := self getWordyName: guideName forCategory: catKey.
+ 						articles add: {guideName. guideTitle}.
+ 					].
+ 				index at: catKey put: articles.
+ 			].
+ 	^index.!

Item was added:
+ ----- Method: QuickGuideMorph class>>defaultOrderIn: (in category 'defaults') -----
+ defaultOrderIn: helpCategory
+ 
+ 	| baseNames suggestedOrder ret last |
+ 	baseNames := FileNameStems.	"don't reread every time"
+ 
+ 	suggestedOrder _ self suggestedOrder.
+ 	helpCategory ifNotNil: [
+ 		suggestedOrder _ suggestedOrder select: [:e | e beginsWith: helpCategory].
+ 		baseNames _ baseNames select: [:e | e beginsWith: helpCategory]].
+ 
+ 	ret _ OrderedCollection new.
+ 	baseNames _ baseNames collect: [:bb | bb withoutTrailingDigits].
+ 	suggestedOrder do: [:e |
+ 		(baseNames includes: e) ifTrue: [
+ 			baseNames remove: e.
+ 			ret add: e.
+ 		].
+ 	].
+ 	baseNames ifNotEmpty: [
+ 		baseNames asArray do: [:e |
+ 			last _ ret reverse detect: [:b | 
+ 					b beginsWith: helpCategory]
+ 				ifNone: [ret ifEmpty: [nil] ifNotEmpty: [ret last]].
+ 			last ifNil: [ret add: e]
+ 				ifNotNil: [ret add: e after: last].
+ 		].
+ 	].
+ 	^ ret asArray.
+ !

Item was added:
+ ----- Method: QuickGuideMorph class>>fileNameStems (in category 'defaults') -----
+ fileNameStems
+ 	"Return a collection of the first part of all quickguide files on the disk.  trailing parts are removed (.sexp.data.gz  .xxx.pr)."
+ 
+ 	| dir prs |
+ 	dir _ FileDirectory on: QuickGuideMorph guidePath.
+ 	FileNameStems _ ((dir fileNames select: [:f | f endsWith: '.sexp.data.gz']) collect: 
+ 		[:f | f copyFrom: 1 to: f size - '.sexp.data.gz' size]) asSet.
+ 	prs := ((dir fileNames select: [:f | f endsWith: '.pr']) collect: 
+ 		[:f | f copyFrom: 1 to: f size - '.pr' size]).
+ 	prs := prs collect: [:nn | (nn atWrap: nn size-3) = $. 
+ 		ifTrue: [nn allButLast: 4]
+ 		ifFalse: [nn]].
+ 	^ FileNameStems addAll: prs
+ !

Item was added:
+ ----- Method: QuickGuideMorph class>>getWordyName:forCategory: (in category 'initialization') -----
+ getWordyName: guideName forCategory: guideCategory
+ 	"With guideName and category already filled in, make a name in words.  Remove the cat name, and trailing digits.  Separate words at capital letters.  NavBarHowToUse3 -> 'How To Use'  "
+ 
+ 	| gn mm tt |
+ 	gn _ guideName allButFirst: guideCategory size.
+ 	gn _ gn withoutTrailingDigits.
+ 	mm _ gn size.
+ 	gn reversed doWithIndex: [:cc :ind | 
+ 		ind < mm  ifTrue: [
+ 			cc isUppercase ifTrue: [ 
+ 				tt _ mm + 1 - ind.
+ 				gn _ (gn copyFrom: 1 to: tt-1), ' ', (gn copyFrom: tt to: gn size)].
+ 			cc == $- ifTrue: [
+ 				tt _ mm + 1 - ind.
+ 				gn at: tt put: $ ].	"convert dash to space"
+ 			]].
+ 	^ gn!

Item was added:
+ ----- Method: QuickGuideMorph class>>guidePath (in category 'defaults') -----
+ guidePath
+ 	| sepa localesPath langPath countryPath |
+ 	sepa  := FileDirectory slash.
+ 	localesPath := Smalltalk imagePath, sepa, 'locale'.
+ 
+ 	"Look for current locale first"
+ 	langPath := localesPath, sepa, LocaleID current isoLanguage.
+ 	LocaleID current isoCountry ifNotNil: [
+ 		countryPath := langPath, '_', LocaleID current isoCountry. 
+ 		((FileDirectory on: countryPath ) directoryExists: 'QuickGuides') 
+ 			ifTrue: [^ countryPath, sepa, 'QuickGuides' ]].
+ 	((FileDirectory on: langPath) directoryExists: 'QuickGuides') 
+ 		ifTrue: [^ langPath, sepa, 'QuickGuides' ].
+ 
+ 	"Try English next"
+ 	((FileDirectory on: localesPath, sepa, 'en') directoryExists: 'QuickGuides') 
+ 		ifTrue: [^ localesPath, sepa, 'en', sepa, 'QuickGuides' ].
+ 
+ 	"Old location"
+ 	((FileDirectory on: Smalltalk imagePath) directoryExists: 'QuickGuides') 
+ 		ifTrue: [^ Smalltalk imagePath, sepa, 'QuickGuides' ].
+ 
+ 	"Any language"
+ 	(FileDirectory on: localesPath) directoryNames do: [:dir |
+ 		((FileDirectory on: localesPath, sepa, dir) directoryExists: 'QuickGuides')
+ 			ifTrue: [^ localesPath, sepa, dir, sepa, 'QuickGuides']].
+ 
+ 	"Give up"
+ 	^ nil!

Item was added:
+ ----- Method: QuickGuideMorph class>>indexPage: (in category 'initialization') -----
+ indexPage: anObject
+ 
+ 	IndexPage := anObject.
+ 	IndexPage ifNotNil: [
+ 		IndexPage setNamePropertyTo: 'index'].
+ !

Item was added:
+ ----- Method: QuickGuideMorph class>>indexPageMimeString: (in category 'initialization') -----
+ indexPageMimeString: aString
+ 
+ 	IndexPageMimeString _ aString.
+ !

Item was added:
+ ----- Method: QuickGuideMorph class>>loadIndex (in category 'initialization') -----
+ loadIndex
+ 	"Optional catalog file 'catalog.txt' may be placed to where Quickguide contents resides.  Purpose is to allow UTF8 encoded titles and menu items for guides.  It also suggests an order for guides within a category.
+ :NavBar/Navigator                        <--- categoryName/title of category 
+ PaintBrushes/Brushes                  <--- guideName/title of guide
+ PaintColorPalette/Color Palette
+     Titles for categories and guides can be translated.  
+     The file is UTF8 encoded.
+     File name for each guide contents is <guideName>.sexp.data.gz.
+     <guideName> should be named only with ascii characters.
+ Template of catalog file can be generated by evaluating this:
+         QuickGuideMorph buildDefaultIndex.
+         QuickGuideMorph saveCatalog."
+ 
+ 	| st line rec categoryRec catKey  catTitle guideName guideTitle|
+ 	st := FileStream oldFileOrNoneNamed: QuickGuideMorph guidePath, (FileDirectory slash), 'index.txt'.
+ 	st ifNil: [^ self buildDefaultIndex].
+ 	st wantsLineEndConversion: true.
+ 	st text.
+      Categories := OrderedCollection new.
+ 	PagesForCategory := Dictionary new.
+ 	[st atEnd] whileFalse: [
+ 
+ 		line := (st upTo: Character cr) withoutTrailingBlanks.
+ 		(line first = $: ) ifTrue: [	"Category"
+ 			rec := line allButFirst subStrings: '|'.
+ 			catKey := ((rec at: 1) subStrings: '|') at: 1.
+ 			rec size = 2
+ 				ifTrue:  [ catTitle := rec second]
+ 				ifFalse:[ catTitle := catKey].
+ 			categoryRec := {catKey. catTitle}.
+ 			self replaceInCategories: categoryRec.
+ 
+ 			PagesForCategory at: catKey put: OrderedCollection new.
+ 		] ifFalse: [
+ 			rec := line subStrings: '|'.
+ 			guideName := rec first.
+ 			rec size = 2 
+ 				ifTrue: [
+ 					guideTitle := rec second]
+ 				ifFalse: [
+ 					guideTitle := self getWordyName: guideName forCategory: catKey].
+ 			(PagesForCategory at: catKey ) add: {guideName. guideTitle}.
+ 		]
+ 	].!

Item was added:
+ ----- Method: QuickGuideMorph class>>loadIndexAndPeekOnDisk (in category 'initialization') -----
+ loadIndexAndPeekOnDisk
+ 	"If index.txt is present, load it and then scan the actual folder for extra guides.  Add them to the list."
+ 
+ 	| indCat indPages extras list indList |
+ 	(FileStream concreteStream isAFileNamed: 
+ 		QuickGuideMorph guidePath, (FileDirectory slash), 'index.txt')
+ 			ifTrue: [self loadIndex]
+ 			ifFalse: [^ self buildDefaultIndex].	"no index file"
+ 
+ 	"Add in the guides on disk that are not in index.txt"
+ 	indCat := Categories. 	"from index.txt"
+ 	indPages := PagesForCategory.
+ 	self buildDefaultIndex.	"from the file directory"
+ 	Categories "from disk" do: [:categoryRec |
+ 		indCat detect: [:pair | pair first = categoryRec first] 
+ 			ifNone: [indCat addLast: categoryRec]].
+ 	PagesForCategory "from disk" associationsDo: [:pair |
+ 		 (indPages includesKey: pair key) 
+ 			ifFalse: [indPages at: pair key put: pair value]
+ 			ifTrue: [list := pair value.
+ 				indList := indPages at: pair key.
+ 				extras := OrderedCollection new.
+ 				list do: [:diskPair |
+ 					indList detect: [:indPair | indPair first = diskPair first]
+ 						ifNone: [extras addLast: diskPair]].
+ 				indPages at: pair key put: indList, extras]].
+ 	Categories := indCat.
+ 	PagesForCategory := indPages.!

Item was added:
+ ----- Method: QuickGuideMorph class>>preloadIndexPage (in category 'initialization') -----
+ preloadIndexPage
+ 	self new checkForIndexOnDisk
+ 		ifFalse: [self error: 'index page not found'].
+ !

Item was added:
+ ----- Method: QuickGuideMorph class>>purgeIndexProjects (in category 'initialization') -----
+ purgeIndexProjects
+ 	"remove all projects that came from loading the index guide."
+ 
+ 	| px nn |
+ 	[px _ Project allProjects detect: [:pp | pp name beginsWith: 'index'] ifNone: [nil].
+ 	px ifNotNil: [
+ 		nn _ Project allProjects indexOf: px.
+ 		Project allProjects removeAt: nn].
+ 	px == nil] whileFalse.
+ 	Smalltalk garbageCollect. 
+ !

Item was added:
+ ----- Method: QuickGuideMorph class>>replaceInCategories: (in category 'initialization') -----
+ replaceInCategories: catPair
+ 	"Find an entry in Categories with the same first element (untranslated), and replace that entry.  If not found, put at end.  For translated name to replace default."
+ 
+ 	Categories withIndexDo: [:oldPair :ind |
+ 		oldPair first = catPair first ifTrue: [
+ 			^ Categories at: ind put: catPair]].
+ 	Categories add: catPair.!

Item was added:
+ ----- Method: QuickGuideMorph class>>saveIndex (in category 'initialization') -----
+ saveIndex
+ 	"Note: file is put into Etoys folder.  A person must move it to resources/QuickGuides"
+ 	|stream |
+ 	stream := FileStream forceNewFileNamed: 'index.txt'.
+ 	stream lineEndConvention: #lf.
+ 	stream converter: UTF8TextConverter new.
+ 	[
+ 		Categories 
+ 			do: [:catRecord |
+ 				stream nextPut: $:.
+ 				stream nextPutAll: catRecord first.  "category key"
+ 				(catRecord second ) = (catRecord first) 
+ 					ifFalse:[
+ 						stream nextPut: $|.
+ 						stream nextPutAll: catRecord second.  "category title (translated)"
+ 					].
+ 				stream cr.
+ 
+ 				(PagesForCategory at: (catRecord first)) 
+ 					do: [:rec |
+ 						stream nextPutAll: rec first.	"guideName"
+ 						stream nextPut: $|.
+ 						stream nextPutAll: rec second.			"guide title (translated)"
+ 						stream cr.
+ 					]
+ 			]
+ 	]  ensure: [stream close].!

Item was added:
+ ----- Method: QuickGuideMorph class>>suggestedCategoryOrder (in category 'defaults') -----
+ suggestedCategoryOrder
+ 
+ 	^ #(
+ 	'NavBar'
+ 	'Paint'
+ 	'Halo'
+ 	'Supplies'
+ 	'ObjectCat'
+ 	'Books'
+ 	'ScriptTile'
+ 	'Menu'
+ 	)!

Item was added:
+ ----- Method: QuickGuideMorph class>>suggestedOrder (in category 'defaults') -----
+ suggestedOrder
+ 
+ 	^ #(
+ 	'BooksTopBorderIcons'
+ 	'BooksExpandedControls'
+ 	'BooksWorking-withLayers'
+ 	'BooksViewerCategoryTiles'
+ 	'HaloMake-theHandlesShow'
+ 	'HaloViewer-ofScriptTiles'
+ 	'HaloSizeColorCopy'
+ 	'HaloMove-andPickUp'
+ 	'HaloRotateHandle'
+ 	'HaloTrash'
+ 	'HaloArrow-atCenter'
+ 	'HaloCenter-ofRotation'
+ 	'HaloMenuTools'
+ 	'HaloMake-aScriptTile'
+ 	'HaloCollapse'
+ 	'MenuNormalTicking'
+ 	'MenuViewerIconsSet'
+ 	'MenuScriptorIconsSet'
+ 	'MenuButtonFires-aScript'
+ 	'MenuGrabMeRevealMe'
+ 	'MenuWatchers'
+ 	'NavBarKeepFindProjects'
+ 	'NavBarChoose-aLanguage'
+ 	'ObjectCatSliderBar'
+ 	'ObjectCatGrabPatchTool'
+ 	'ObjectCatLassoTool'
+ 	'ObjectCatDigitalImages'
+ 	'ObjectCatMakerButton'
+ 	'PaintBrushes'
+ 	'PaintColorPalette'
+ 	'PaintBucketTool'
+ 	'PaintStraightLineTool'
+ 	'PaintEllipseTool'
+ 	'PaintRectangleTool'
+ 	'PaintPolygonTool'
+ 	'PaintColorPicker'
+ 	'PaintStampsTool'
+ 	'ScriptTileForward-by'
+ 	'ScriptTileTurn-by'
+ 	'ScriptTilesForward-andTurn'
+ 	'ScriptTileBounceMotion'
+ 	'ScriptTileX-andYTiles'
+ 	'ScriptTilesTestsCategory'
+ 	'ScriptTilePenUse'
+ 	'ScriptTilePlayfieldTrail'
+ 	'ScriptTileBatchTrail'
+ 	'ScriptTileStamps'
+ 	'ScriptTileHeading'
+ 	'ScriptTileScaleFactor'
+ 	'ScriptTileHide-andShow'
+ 	'ScriptTileWorldInput'
+ 	'ScriptTileSoundCategory'
+ 	'SuppliesObjectCatalog'
+ 	'SuppliesText'
+ 	'SuppliesAllScripts'
+ 	'SuppliesJoystickControl'
+ 	'SuppliesSoundRecorder'
+ 	)!

Item was added:
+ ----- Method: QuickGuideMorph>>allGuidesToWeb (in category 'write web pages') -----
+ allGuidesToWeb
+ 	"Write out web pages for each of the Guides in the QuickGuides folder.  In an inspector on the current help flap, evaluate
+ 
+ 	self allGuidesToWeb.
+ 
+ Write both a web page and the .jpegs for each guide page.
+ Method to write N new guides, and update the index for the others:
+ 	self rewriteGuidesAndIndexInOthers: 'name name name'.
+ 
+ Return the text for the wiki page:  http://wiki.laptop.org/go/Etoys_QuickGuides_Index
+ 	self guidesIndexForWiki.
+ 
+ To allow the text in Guides to show in other languages.
+ When the text of guides change, we need to write it out to the .pot and .po files.
+ 
+ To translate guides that are already written out in English:
+ In the folder po/quickguides/  copy an existing .po file and name it similar to pt-BR.po (pt for Portugese and BR for Brazil).
+ Edit the file in a UFT-8 aware editor (not the Squeak file list).  
+ Save As in UFT-8.
+ In the shell terminal.  (langCode is pt_BR in this example) execute
+      msgfmt langCode.po -o quickguides.mo
+ (how add on to existing .mo with other languages?)
+ Move quickguides.mo to   lang/langCode/LC_MESSAGES/
+ Get into Etoys, set the language to the language you are working with, and look at a guide.
+ "
+ 	self htmlForJumpTo.	"reset"
+ 	1 to: pages size do: [:ii |
+ 		self goToPage: ii.
+ 		self guideToWebWithJPEGs: true ].
+ 	self beep.!

Item was added:
+ ----- Method: QuickGuideMorph>>allTextIn: (in category 'write web pages') -----
+ allTextIn: aPage
+ 	"Return a string of all the text in all the textMorphs on this page. separated by period space space."
+ 
+ 	| tt |
+ 	^ String streamContents: [:strm |
+ 		aPage allMorphsDo: [:mm |
+ 			(mm isKindOf: TextMorph) ifTrue: [
+ 				tt _ mm contents string withBlanksTrimmed.
+ 				strm nextPutAll: tt.
+ 				(tt size > 0 and: [tt last ~= $.]) ifTrue: [strm nextPut: $.].
+ 				strm space; space]]].!

Item was added:
+ ----- Method: QuickGuideMorph>>checkForIndexOnDisk (in category 'transition') -----
+ checkForIndexOnDisk
+ 	"For localization.  Look on disk every time for a new Index. Overwrite IndexPage if found."
+ 
+ 	| dir holder |
+ 	dir _ FileDirectory on: QuickGuideMorph guidePath.
+ 	(dir fileExists: 'index.pr') ifFalse: [
+ 		(dir fileExists: 'index.sexp.data.gz') ifFalse: [^ false]].
+ 	holder _ pages first.
+ 	holder guideName: 'index'. 
+ 	holder guideCategory: ''. 
+ 	holder load.	"allow index.sexp.data.gz"
+ 	IndexPage _  holder submorphs first.
+ 	^ true
+ 
+ "	IndexPage _ QuickGuideHolderMorph new loadPR: 'index.pr' dir: dir.	"
+ !

Item was added:
+ ----- Method: QuickGuideMorph>>delete (in category 'submorphs add/remove') -----
+ delete
+ 
+ 	self unloadPages.
+ 	super delete.
+ !

Item was added:
+ ----- Method: QuickGuideMorph>>descriptionReport (in category 'menu actions') -----
+ descriptionReport
+ 
+ 	^ currentPage guideNameInWords
+ !

Item was added:
+ ----- Method: QuickGuideMorph>>goToCardNamed: (in category 'menu actions') -----
+ goToCardNamed: cardName
+ 
+ 	| page inner |
+ 	page _ pages detect: [:p | p guideName = cardName] ifNone: [nil].
+ 	page ifNotNil: [self goToPage: (self pageNumberOf: page).
+ 		(inner := currentPage findA: BookMorph) ifNotNil: [
+ 			inner currentPage player ifNotNil: [
+ 				inner currentPage player runAllOpeningScripts]]].
+ !

Item was added:
+ ----- Method: QuickGuideMorph>>goToIndex (in category 'menu actions') -----
+ goToIndex
+ 	"Return to the index Guide"
+ 
+ 	"(submorphs first isKindOf: QuickGuideHolderMorph) ifTrue: [submorphs first unload]."
+ 	"do we need to unload in every page (new guide) transition?"
+ 	self initializeIndexPage.!

Item was added:
+ ----- Method: QuickGuideMorph>>goToPageMorph:transitionSpec: (in category 'transition') -----
+ goToPageMorph: newPage transitionSpec: transitionSpec
+ 
+ 	newPage load.
+ 	super goToPageMorph: newPage transitionSpec: transitionSpec.
+ !

Item was added:
+ ----- Method: QuickGuideMorph>>guideToWeb (in category 'write web pages') -----
+ guideToWeb
+ 	"Write all the info in this guide to a web page.  Pages are images (jPEGs).  Create a page to hold them."
+ 
+ 	self guideToWebWithJPEGs: true.!

Item was added:
+ ----- Method: QuickGuideMorph>>guideToWebWithJPEGs: (in category 'write web pages') -----
+ guideToWebWithJPEGs: withPics
+ 	"Write all the info in this guide to a web page.  Pages are images (jPEGs).  Create a page to hold them."
+ 
+ 	| dir qgh bk strm ff allText thisText |
+ 	dir _ FileDirectory default directoryNamed: 'QG-web'.
+ 	"picutres of guide pages"
+ 	qgh _ self submorphOfClass: QuickGuideHolderMorph.
+ 	(bk _ qgh submorphOfClass: BookMorph) ifNil: [^ self].
+ 	strm _ WriteStream on: (String new: 500).
+ 	strm nextPutAll: (self htmlPreamble: qgh guideNameInWords).	"includes index side bar"
+ 	allText _ ''.
+ 
+ 	1 to: bk pages size do: [:ii |
+ 		withPics ifTrue: [	"Make images of pages"
+ 			bk goToPage: ii.	"show it"
+ 			self jPegOutDir: dir].
+ 		thisText _ self allTextIn: (bk pages at: ii).
+ 		strm nextPutAll: '		  <tr><td>  <img  alt="'.
+ 		strm nextPutAll: qgh guideName, ', page ', ii printString,'. ', thisText, '"  src="./'.
+ 		strm nextPutAll: qgh guideName , '-', ii printString,'.jpg"> </tr></tc>
+ '.
+ 		allText _ allText, thisText].
+ 
+ 	strm nextPutAll: '		</table>
+ 
+ </td></tc>
+ </table>
+ 
+ <p><a href="#thetop">Jump to Top</a></p>
+ 
+ <p>Squeak Etoys is a "media authoring tool"-- software that you can download to your computer <br>
+ and then use to create your own media.  You can write out your project and share it with others.  <br>
+ Etoys runs on any Mac or Windows machine, as well as on the OLPC XO machine.  <br>
+ It is free. &nbsp;&nbsp;
+ 	<a href="http://www.squeakland.org/whatis/whatismain.html">Find out about Etoys.</a></p>
+ 
+ <p><br><br>Text of this guide (for searching): ', allText, '</p>
+ </body>
+ </html>                  '.
+ 	ff _ dir fileNamed: qgh guideName, '.html'.
+ 	ff nextPutAll: strm contents; close.!

Item was added:
+ ----- Method: QuickGuideMorph>>guidesIndexForWiki (in category 'write web pages') -----
+ guidesIndexForWiki
+ 	"Create the html for a long list of guide categories and guides.  Each is a clickable link.  For the laptop.org wiki.  An index to the web pages for the Guides.
+ 	Inspect a Guide and go up the owner chain to a QuickGuideMorph.   self  guidesIndexForWiki     "
+ 
+ 	| strm |
+ 	strm _ WriteStream on: (String new: 6000).
+ 
+ 	strm nextPutAll: 'At the top left of the screen in Etoys is a "?" button.  Clicking it brings up a help flap with more than 50 QuickGuides.  These tell how to use different parts of Etoys.  
+ 
+ [[Image:Help-icon.jpeg]]
+ 
+ The QuickGuides are also available on the web.  Note that the active buttons and Etoys controls will not work in the web version.
+ __NOTOC__'; cr.
+ 	strm nextPutAll: '=== Guides about topics in EToys ==='; cr; cr.
+ 
+ 	self class categoryNamesDo: [:catName |
+ 		strm nextPutAll: '==== '; nextPutAll: catName translated; nextPutAll: ' ===='; cr.
+ 		pages do: [:pp |
+ 			pp guideCategory = catName ifTrue: [
+ 				strm nextPutAll: '* [http://tinlizzie.org/olpc/QG-web/', pp guideName, '.html'.
+ 				strm space; nextPutAll: pp guideNameInWords translated; nextPutAll: ']'; cr.
+ 				]].
+ 		].
+ 	^ strm contents
+ 
+ 	"&nbsp;"!

Item was added:
+ ----- Method: QuickGuideMorph>>handCopyCard (in category 'menu actions') -----
+ handCopyCard
+ 
+ 	^ self world primaryHand attachMorph: currentPage submorphs first veryDeepCopy.
+ !

Item was added:
+ ----- Method: QuickGuideMorph>>htmlForJumpTo (in category 'write web pages') -----
+ htmlForJumpTo
+ 	"Create the html for a long list of guide categories and guides.  Each is a clickable link.  Store in the class var HTMLJumpTo.  For creating web pages from the Guides."
+ 
+ 	| strm ap |
+ 	1 to: pages size do: [:ii | self goToPage: ii].	"create all pages" 
+ 	strm _ WriteStream on: (String new: 500).
+ 	strm nextPutAll: '<b>Guides about topics in EToys</b><br>
+ <i>Help screens for the OLPC<br> XO machine.</i><br>'.
+ 
+ 	Categories do: [:pair |
+ 		strm nextPutAll: pair second translated; nextPutAll: '<br>'; cr.
+ 		(PagesForCategory at: pair first) do: [:gPair |
+ 			ap := pages detect: [:p | (p hasProperty: #quickGuideHolder) and: [p knownName = gPair first]] ifNone: [nil].
+ 			(ap submorphOfClass: BookMorph) ifNotNil: ["exists"
+ 				strm tab; tab.
+ 				strm nextPutAll: '&nbsp;&nbsp;&nbsp;<a href="./', gPair first, '.html">'.
+ 				strm nextPutAll: gPair second; nextPutAll: '</a><br>'; cr]]].
+ 	^ HTMLJumpTo _ strm contents!

Item was added:
+ ----- Method: QuickGuideMorph>>htmlPreamble: (in category 'write web pages') -----
+ htmlPreamble: theGuideName
+ 	"All the stuff at the beginning of an html file.  Includes the JumpTo menu of links to other Guides."
+ 
+ 	| strm |
+ 	strm _ WriteStream on: (String new: 500).
+ 	strm nextPutAll: '<!!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+ <html>
+  <head>
+   <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
+  <title>'.
+ 
+ 	strm nextPutAll: theGuideName.
+ 	strm nextPutAll: ', an Etoys Quick Guide</title>
+  </head>
+  <body bgcolor="#cef2ff" text="#000000">
+  <A NAME="thetop">
+  <h1 align="center">'.
+ 	strm nextPutAll: theGuideName.
+ 	strm nextPutAll: '</h1>'.
+ 	strm nextPutAll: '<h3 align="center">A Quick Guide for Etoys on the OLPC XO</h3>
+ 
+ <table border="0" cellspacing="0" cellpadding="6">
+   <tc valign ="top"><td valign ="top"> 
+ <br>'.
+ 	strm nextPutAll: HTMLJumpTo.	"Jump to menu"
+ 	strm nextPutAll: '
+  </td></tc>
+ 
+ 
+  <tc> <td>
+ 	<table border="0" cellspacing="0" cellpadding="12">
+ '.
+ 	^ strm contents!

Item was added:
+ ----- Method: QuickGuideMorph>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	| newPage |
+ 	self beSticky.
+ 	newPagePrototype _ QuickGuideHolderMorph new.
+ 	newPagePrototype guideName: 'empty'.
+ 	newPagePrototype setProperty: #transitionSpec toValue: (Array with:  'silence' with: #none with: #none).
+ 	super initialize.
+ 	order _ OrderedCollection with: 'index'.
+ 
+ 	newPage _ newPagePrototype veryDeepCopy.
+ 	newPage guideName: 'index'.
+ 	self insertPage: newPage pageSize: 100 at 100 atIndex: 1.
+ 	self goToPage: 2.
+ 	self deletePageBasic.
+ 	self pageControlsAtTop: false.
+ 	self jumpToAdjust: self pageControls.!

Item was added:
+ ----- Method: QuickGuideMorph>>initializeIndexPage (in category 'initialization') -----
+ initializeIndexPage
+ 
+ 	| indexPage firstPage |
+ 	"debugging only -- look on disk"
+ 	self checkForIndexOnDisk ifTrue: [
+ 		self goToPage: 1.
+ 		^ self]. 	"Done.  sets IndexPage every time if found"
+ 
+ 	IndexPage ifNotNil: [
+ 		indexPage _ IndexPage veryDeepCopy.
+ 		firstPage _ pages first.
+ 		indexPage position: firstPage position.
+ 		indexPage beSticky.
+ 		firstPage extent: indexPage extent.
+ 		firstPage submorphs size > 0 ifTrue: [firstPage submorphs last delete].
+ 		firstPage submorphs size > 0 ifTrue: [firstPage submorphs last delete].
+ 		firstPage addMorph: indexPage.
+ 		self goToPage: 1.
+ 	].
+ !

Item was added:
+ ----- Method: QuickGuideMorph>>jPegOutDir: (in category 'write web pages') -----
+ jPegOutDir: fileDir
+ 	"Write the current page of the current Guide as an image file on the directory"
+ 	"Does it need to be showing?"
+ 
+ 	| fName gn num qgh bk |
+ 
+ 	qgh _ self submorphOfClass: QuickGuideHolderMorph.
+ 	bk _ qgh submorphOfClass: BookMorph.
+ 	num _ (bk pages indexOf: bk currentPage ifAbsent: [0]) printString.
+ 	gn _ qgh guideName. 
+ 	fName _ fileDir pathName, fileDir pathNameDelimiter asString, gn, '-', num, '.jpg'.
+ 	currentPage imageForm writeJPEGfileNamed: fName.
+ 	"need to go deeper??"
+ 	^ ''!

Item was added:
+ ----- Method: QuickGuideMorph>>jumpToAdjust: (in category 'page controls') -----
+ jumpToAdjust: pageControlColumn
+ 	"Change look of JumpTo: button, since specs don't have enough options."
+ 
+ 	| bar jump |
+ 	bar _ pageControlColumn firstSubmorph firstSubmorph.
+ 	jump _ bar submorphThat: [:mm |
+ 		mm class == SimpleButtonMorph and: [mm actionSelector == #showJumpToMenu]
+ 		]  ifNone: [^ nil].
+ 	jump color: (Color r: 0.839 g: 1.0 b: 0.806);
+ 		borderColor: (Color gray: 0.6);
+ 		actWhen: #buttonUp.
+ !

Item was added:
+ ----- Method: QuickGuideMorph>>loadPages (in category 'initialization') -----
+ loadPages
+ 	| pageCount newPages page unusedPages |
+ 	pageCount := PagesForCategory inject: 0 into: [:arg :each | arg + (each size)].
+ 	newPages _ OrderedCollection new: pageCount.
+ 
+ 	page _ pages detect: [:p | (p hasProperty: #quickGuideHolder) and: [p knownName = 'index']] ifNone: [nil].
+ 	page ifNil: [
+ 		page _ QuickGuideHolderMorph new.
+ 		page guideName: 'index' translated.
+ 		page setProperty: #transitionSpec toValue:  (Array with:  'silence' with: #none with: #none).
+ 	].
+ 	page guideNameInWords ifNil: [
+ 			page guideNameInWords: 'Index' translated].
+ 	newPages add: page.
+ 
+      Categories do: [:categoryRec | | catKey  |
+ 		catKey := categoryRec first.
+ 		(PagesForCategory at: catKey) do:  [: rec || guideName guideTitle |
+ 			guideName := rec first.
+ 			guideTitle := rec second.
+ 			page _ pages detect: [:p | (p hasProperty: #quickGuideHolder) and: [p knownName = guideName]] ifNone: [nil].
+ 			page ifNil: [
+ 				page _ QuickGuideHolderMorph new.
+ 				page guideName: guideName.
+ 				page guideNameInWords: guideTitle.
+ 				page setProperty: #transitionSpec toValue:  (Array with:  'silence' with: #none with: #none).
+ 			].
+ 			newPages add: page.
+ 		].
+ 	].
+ 		
+ 	unusedPages _ pages reject: [:e | (newPages includes: e)].
+ 	self newPages: (newPages, unusedPages) currentIndex: 1.!

Item was added:
+ ----- Method: QuickGuideMorph>>makeCategoryMenu: (in category 'menu actions') -----
+ makeCategoryMenu: catName
+ 	"return a menu with all guides in this category.  No title"
+ 
+ 	| subMenu |
+ 	subMenu _ MenuMorph new defaultTarget: self.
+ 	PagesForCategory ifNil: [self class loadIndexAndPeekOnDisk].
+ 	(PagesForCategory at: catName ifAbsent: [#()]) 
+ 			do: [:articleRec |
+ 				subMenu add: (articleRec second) 
+ 							target: self 
+ 							selector: #goToCardNamed: 
+ 							argument: (articleRec first)].
+ 	^ subMenu!

Item was added:
+ ----- Method: QuickGuideMorph>>nextCard (in category 'menu actions') -----
+ nextCard
+ 
+ 	^ super nextPage.
+ !

Item was added:
+ ----- Method: QuickGuideMorph>>nextPage (in category 'menu actions') -----
+ nextPage
+ 
+ 	| b |
+ 	b _ currentPage findA: BookMorph.
+ 	b ifNotNil: [b nextPage. ^ self].
+ !

Item was added:
+ ----- Method: QuickGuideMorph>>order: (in category 'initialization') -----
+ order: names
+ 
+ 	| newPages page unusedPages |
+ 	newPages _ OrderedCollection new: names size.
+ 	((Array with: 'index'), names asArray) do: [:n |
+ 		page _ pages detect: [:p | (p hasProperty: #quickGuideHolder) and: [p knownName = n]] ifNone: [nil].
+ 		page ifNil: [
+ 			page _ QuickGuideHolderMorph new.
+ 			page guideName: n.
+ 			page setProperty: #transitionSpec toValue:  (Array with:  'silence' with: #none with: #none).
+ 		].
+ 		newPages add: page.
+ 	].
+ 		
+ 	unusedPages _ pages reject: [:e | (newPages includes: e)].
+ 	self newPages: (newPages, unusedPages) currentIndex: 1.
+ 	order _ names.
+ !

Item was added:
+ ----- Method: QuickGuideMorph>>pageNumberReport (in category 'page controls') -----
+ pageNumberReport
+ 
+ 	| b |
+ 	b _ currentPage findA: BookMorph.
+ 	b ifNotNil: [^ b pageNumberReport].
+ 	^ super pageNumberReport.
+ !

Item was added:
+ ----- Method: QuickGuideMorph>>previousCard (in category 'menu actions') -----
+ previousCard
+ 
+ 	^ super previousPage.
+ !

Item was added:
+ ----- Method: QuickGuideMorph>>previousPage (in category 'menu actions') -----
+ previousPage
+ 
+ 	| b |
+ 	b _ currentPage findA: BookMorph.
+ 	b ifNotNil: [b previousPage. ^ self].
+ !

Item was added:
+ ----- Method: QuickGuideMorph>>rewriteGuidesAndIndexInOthers: (in category 'write web pages') -----
+ rewriteGuidesAndIndexInOthers: nameList
+ 	"Create new files for guides in list, including jpegs.  For all other guides, just redo the HTML to get a revised index column."
+ 
+ self htmlForJumpTo.	"reset"
+ nameList do: [:gg |
+ 	self goToCardNamed: gg.
+ 	self guideToWebWithJPEGs: true ].
+ 
+ 	"Later could make entire html for a guide without loading it.  See htmlForJumpTo "
+ 1 to: pages size do: [:ii |
+ 	self goToPage: ii.
+ 	self guideToWebWithJPEGs: false ].
+ self beep.!

Item was added:
+ ----- Method: QuickGuideMorph>>shortControlSpecs (in category 'page controls') -----
+ shortControlSpecs
+ 
+ 	^ {
+ 		#spacer.
+ 		#pageNumber.
+ 		#variableSpacer.
+ 		{#PrevPage. 		#previousPage.			'Previous page' translated}.
+ 		#spacer.
+ 		#showDescription.
+ 		#spacer.
+ 		{#NextPage.		#nextPage.				'Next page' translated}.
+ 		#variableSpacer.
+ 		{' ', 'Jump to...' translated, ' '.	#showJumpToMenu.		'Menu to see another Guide' translated.	#border}.
+ 			"further adjusted in jumpToAdjust: "
+ 		#spacer.
+ 	}!

Item was added:
+ ----- Method: QuickGuideMorph>>showDescriptionMenu: (in category 'menu actions') -----
+ showDescriptionMenu: evt
+ 	"The Jump To menu.  Choose a guide to see next"
+ 	| aMenu subMenu aWorld pos |
+ 	aMenu _ MenuMorph new defaultTarget: self.
+ 	aMenu addTitle: 'Quick Guides' translated.
+ 
+ 	self class categoryNamesDo: [:catName |
+ 		subMenu _ self makeCategoryMenu: catName.
+ 		subMenu items ifNotEmpty: [
+ 				aMenu add: (self class categoryTitleOf: catName)
+ 							subMenu: subMenu]].
+ 	aMenu add: 'Index' translated action: #goToIndex.
+ 	aWorld _ aMenu currentWorld.
+ 	pos _ aWorld primaryHand position - (aMenu fullBounds extent) + (-2 at 30).
+ 	aMenu popUpAt: pos forHand: aWorld primaryHand in: aWorld.
+ !

Item was added:
+ ----- Method: QuickGuideMorph>>showJumpToMenu (in category 'menu actions') -----
+ showJumpToMenu
+ 
+ 	self showDescriptionMenu: nil
+ !

Item was added:
+ ----- Method: QuickGuideMorph>>showMenuCategory: (in category 'menu actions') -----
+ showMenuCategory: catName
+ 	"put up a menu with all guides in this category"
+ 
+ 	| subMenu |
+ 	subMenu _ self makeCategoryMenu: catName.
+ 	subMenu addTitle: (self class categoryTitleOf: catName).
+ 	subMenu popUpInWorld.!

Item was added:
+ ----- Method: QuickGuideMorph>>showPageControls: (in category 'page controls') -----
+ showPageControls: controlSpecs
+ 
+ 	^ self showPageControls: controlSpecs allowDragging: false. 	"Do not drag Guide out of flap easily"
+ !

Item was added:
+ ----- Method: QuickGuideMorph>>unloadPages (in category 'submorphs add/remove') -----
+ unloadPages
+ 
+ 	pages do: [:e | e unload].
+ !

Item was added:
+ FormInput subclass: #RadioButtonInput
+ 	instanceVariableNames: 'inputSet state value button'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Forms'!

Item was added:
+ ----- Method: RadioButtonInput class>>inputSet:value: (in category 'instance creation') -----
+ inputSet: anInputSet  value: aString
+ 	^self new inputSet: anInputSet  value: aString
+ !

Item was added:
+ ----- Method: RadioButtonInput>>button: (in category 'private-initialization') -----
+ button: aMorph
+ 	button _ aMorph!

Item was added:
+ ----- Method: RadioButtonInput>>inputSet:value: (in category 'private-initialization') -----
+ inputSet: anInputSet  value: aString
+ 	inputSet _ anInputSet.
+ 	value _ aString.
+ 	state _ false.!

Item was added:
+ ----- Method: RadioButtonInput>>pressed (in category 'button state') -----
+ pressed
+ 	^state!

Item was added:
+ ----- Method: RadioButtonInput>>pressed: (in category 'button state') -----
+ pressed: aBoolean
+ 	state _ aBoolean.
+ 	self changed: #pressed.
+ 	button ifNotNil: [button step].
+ 	^true!

Item was added:
+ ----- Method: RadioButtonInput>>toggle (in category 'button state') -----
+ toggle
+ 	"my button has been clicked on!!"
+ 
+ 	self pressed: self pressed not.
+ 	inputSet  buttonToggled: self.
+ 	^true!

Item was added:
+ ----- Method: RadioButtonInput>>valueIfPressed (in category 'access') -----
+ valueIfPressed
+ 	^value!

Item was added:
+ FormInput subclass: #RadioButtonSetInput
+ 	instanceVariableNames: 'name buttons defaultButton'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Forms'!

Item was added:
+ ----- Method: RadioButtonSetInput class>>name: (in category 'instance creation') -----
+ name: aString
+ 	^self new name: aString!

Item was added:
+ ----- Method: RadioButtonSetInput>>active (in category 'input handling') -----
+ active
+ 	"we are active if and only if one of our buttons is pressed"
+ 	self name isNil
+ 		ifTrue: [^false].
+ 	buttons do: [ :b |
+ 		b pressed ifTrue: [ ^true ] ].
+ 	^false!

Item was added:
+ ----- Method: RadioButtonSetInput>>addInput: (in category 'access') -----
+ addInput: buttonInput
+ 	buttons add: buttonInput!

Item was added:
+ ----- Method: RadioButtonSetInput>>buttonToggled: (in category 'input handling') -----
+ buttonToggled: aButton
+ 	"a button was toggled; turn all other buttons off"
+ 	buttons do: [ :b |
+ 		b == aButton ifFalse: [
+ 			b pressed: false  ] ].!

Item was added:
+ ----- Method: RadioButtonSetInput>>defaultButton: (in category 'access') -----
+ defaultButton: aButton
+ 	"set which button to toggle on after a reset"
+ 	defaultButton _ aButton!

Item was added:
+ ----- Method: RadioButtonSetInput>>isRadioButtonSetInput (in category 'testing') -----
+ isRadioButtonSetInput
+ 	^true!

Item was added:
+ ----- Method: RadioButtonSetInput>>name (in category 'access') -----
+ name
+ 	^name!

Item was added:
+ ----- Method: RadioButtonSetInput>>name: (in category 'private-initialization') -----
+ name: aString
+ 	name _ aString.
+ 	buttons _ OrderedCollection new.!

Item was added:
+ ----- Method: RadioButtonSetInput>>reset (in category 'input handling') -----
+ reset
+ 	buttons do: [ :b |
+ 		b pressed: (b == defaultButton) ].
+ !

Item was added:
+ ----- Method: RadioButtonSetInput>>value (in category 'input handling') -----
+ value
+ 	buttons do: [ :b |
+ 		b pressed ifTrue: [ ^b valueIfPressed ] ].
+ 	self error: 'asked for value when inactive!!'.!

Item was added:
+ ----- Method: Random class>>theItsCompletelyBrokenTest (in category '*Etoys-Squeakland-testing') -----
+ theItsCompletelyBrokenTest
+ 	"Random theItsCompletelyBrokenTest"
+ 	"The above should print as...
+ 	(0.149243269650845 0.331633021743797 0.75619644800024 0.393701540023881 0.941783181364547 0.549929193942775 0.659962596213428 0.991354559078512 0.696074432551896 0.922987899707159 )
+ 	If they are not these values (accounting for precision of printing) then something is horribly wrong: DO NOT USE THIS CODE FOR ANYTHING. "
+ 	| rng |
+ 	rng := Random new.
+ 	rng seed: 2345678901.
+ 	^ (1 to: 10) collect: [:i | rng next]!

Item was changed:
  ----- Method: RandomNumberTile class>>registerInFlapsRegistry (in category 'class initialization') -----
  registerInFlapsRegistry
+ 	"Register the receiver in the system's flaps registry.  Or, now that this class is disused, do not..."
+ 
+ 	true ifTrue: [^ self].
+ 
- 	"Register the receiver in the system's flaps registry"
  	self environment
  		at: #Flaps
+ 		ifPresent: [:cl | cl registerQuad: {#RandomNumberTile.	#new.	'Random' translatedNoop.		'A random-number tile for use with tile scripting' translatedNoop}
- 		ifPresent: [:cl | cl registerQuad: #(RandomNumberTile		new		'Random'		'A random-number tile for use with tile scripting')
  						forFlapNamed: 'PlugIn Supplies'.
+ 						cl registerQuad: {#RandomNumberTile. #new.	 'Random' translatedNoop.		'A tile that will produce a random number in a given range' translatedNoop}
- 						cl registerQuad: #(RandomNumberTile	new	'Random'		'A tile that will produce a random number in a given range')
  						forFlapNamed: 'Scripting'.]!

Item was added:
+ ----- Method: RandomNumberTile>>basicParseNodeWith: (in category '*Etoys-Squeakland-code generation') -----
+ basicParseNodeWith: encoder
+ 
+ 	^ MessageNode new
+ 				receiver: (encoder encodeLiteral: literal)
+ 				selector: #atRandom
+ 				arguments: #()
+ 				precedence: (#atRandom precedence)
+ 				from: encoder
+ 				sourceRange: nil.
+ !

Item was added:
+ ----- Method: RandomNumberTile>>kedamaParseNodeWith:actualObject: (in category '*Etoys-Squeakland-code generation') -----
+ kedamaParseNodeWith: encoder actualObject: obj
+ 
+ 	^ MessageNode new
+ 				receiver: (encoder encodePlayer: obj)
+ 				selector: #random:
+ 				arguments: (encoder encodeLiteral: literal)
+ 				precedence: (#random: precedence)
+ 				from: encoder
+ 				sourceRange: nil.
+ !

Item was added:
+ ----- Method: RandomNumberTile>>labelMorphs (in category '*Etoys-Squeakland-misc') -----
+ labelMorphs
+ 
+ 	^ submorphs select: [:m | m isKindOf: StringMorph].
+ !

Item was added:
+ ----- Method: RandomNumberTile>>parseNodeWith: (in category '*Etoys-Squeakland-accessing') -----
+ parseNodeWith: encoder
+ 
+ 	| phrase player costume |
+ 	phrase _ self outermostMorphThat: [:m| m isKindOf: PhraseTileMorph].
+ 	phrase ifNil: [^ self basicParseNodeWith: encoder].
+ 
+ 	player _ phrase associatedPlayer.
+ 	player ifNil: [^ self basicParseNodeWith: encoder].
+ 
+ 	costume _ player costume.
+ 	costume ifNil: [^ self basicParseNodeWith: encoder].
+ 
+ 	(player isKindOf: KedamaExamplerPlayer) ifTrue: [
+ 		^ self kedamaParseNodeWith: encoder actualObject: player costume renderedMorph kedamaWorld player].
+ 
+ 	(costume renderedMorph isMemberOf: KedamaMorph) ifTrue: [
+ 		^ self kedamaParseNodeWith: encoder actualObject: self].
+ 
+ 	^ self basicParseNodeWith: encoder.
+ !

Item was added:
+ ----- Method: RandomNumberTile>>sexpWith: (in category '*Etoys-Squeakland-accessing') -----
+ sexpWith: dictionary
+ 	| n elements |
+ 	n _ SExpElement keyword: #send.
+ 	n attributeAt: #type put: 'Number'.
+ 	elements _ Array with: ((SExpElement keyword: #selector)
+ 					attributeAt: #selector put: 'atRandom'; yourself)
+ 				with: ((SExpElement keyword: #literal)
+ 					attributeAt: #type put: 'Number';
+ 					attributeAt: #value put: literal printString;
+ 					yourself).
+ 	n elements: elements.
+ 	^ n.
+ !

Item was changed:
  ----- Method: RandomNumberTile>>storeCodeOn:indent: (in category 'accessing') -----
  storeCodeOn: aStream indent: tabCount
  
  	| phrase player costume |
+ 	phrase _ self outermostMorphThat: [:m| m isKindOf: PhraseTileMorph].
- 	phrase := self outermostMorphThat: [:m| m isKindOf: PhraseTileMorph].
  	phrase ifNil: [^ self basicStoreCodeOn: aStream indent: tabCount].
  
+ 	player _ phrase associatedPlayer.
- 	player := phrase associatedPlayer.
  	player ifNil: [^ self basicStoreCodeOn: aStream indent: tabCount].
  
+ 	costume _ player costume.
- 	costume := player costume.
  	costume ifNil: [^ self basicStoreCodeOn: aStream indent: tabCount].
  
  	(player isKindOf: KedamaExamplerPlayer) ifTrue: [
+ 		^ self kedamaStoreCodeOn: aStream indent: tabCount actualObject: player costume renderedMorph kedamaWorld player].
- 		^ self kedamaStoreCodeOn: aStream indent: tabCount actualObject: player costume renderedMorph kedamaWorld].
  
  	(costume renderedMorph isMemberOf: KedamaMorph) ifTrue: [
+ 		^ self kedamaStoreCodeOn: aStream indent: tabCount actualObject: self].
- 		^ self kedamaStoreCodeOn: aStream indent: tabCount actualObject: costume renderedMorph].
  
  	^ self basicStoreCodeOn: aStream indent: tabCount.!

Item was added:
+ ----- Method: RandomNumberTile>>unhibernate (in category '*Etoys-Squeakland-misc') -----
+ unhibernate
+ 
+ 	self labelMorphs do: [:l | l label: l contents font: Preferences standardEToysFont].
+ 	self removeProperty: #needsLayoutFixed.
+ !

Item was added:
+ ----- Method: ReadWriteStream>>fileOutChangeSet:andObject:withVersionNotification: (in category '*Etoys-Squeakland-fileIn/Out') -----
+ fileOutChangeSet: aChangeSetOrNil andObject: theObject withVersionNotification: withNotification
+ 	"Write a file that has both the source code for the named class and an object as bits.  Any instance-specific object will get its class written automatically."
+ 
+ 	"An experimental version to fileout a changeSet first so that a project can contain its own classes"
+ 
+ 
+ 	self setFileTypeToObject.
+ 		"Type and Creator not to be text, so can attach correctly to an email msg"
+ 	self header; timeStamp.
+ 
+ 	(withNotification or: [aChangeSetOrNil notNil]) ifTrue: [
+ 		withNotification ifTrue: [
+ 			self fileOutVersionCheckNotification.
+ 		].
+ 		aChangeSetOrNil ifNotNil: [
+ 			aChangeSetOrNil fileOutPreambleOn: self.
+ 			aChangeSetOrNil fileOutOn: self.
+ 			aChangeSetOrNil fileOutPostscriptOn: self.
+ 		].
+ 	].
+ 
+ 	self trailer.	"Does nothing for normal files.  HTML streams will have trouble with object data"
+ 
+ 	"Append the object's raw data"
+ 	(SmartRefStream on: self)
+ 		nextPut: theObject;  "and all subobjects"
+ 		close.		"also closes me"
+ !

Item was added:
+ ----- Method: ReadWriteStream>>fileOutVersionCheckNotification (in category '*Etoys-Squeakland-fileIn/Out') -----
+ fileOutVersionCheckNotification
+ 	"Put a version-check bumper onto the project stream."
+ 
+ 	self nextChunkPut: ' | cont | (Smalltalk includesKey: #MorphExtensionPlus) ifFalse: [self inform: ''This project cannot be loaded into an older system.\Please use an OLPC Etoys compatible image.'' translated withCRs.
+ 		cont _ thisContext.
+ 		[cont notNil] whileTrue: [
+ 			cont selector == #handleEvent: ifTrue: [cont return: nil].
+ 			cont _ cont sender.
+ 		]]'; cr.
+ 
+ 	self nextChunkPut: ' | cont | (Smalltalk includesKey: #CalendarMorph) ifFalse:
+ 		[(self confirm:  ''This project was created from a more recent\version of Etoys, and may not load or\work properly in an older system.\Ideally use Etoys 5.0 or newer\proceed anyway?'' translated withCRs) ifFalse:
+ 			[cont _ thisContext.
+ 			[cont notNil] whileTrue: [
+ 				cont selector == #handleEvent: ifTrue: [cont return: nil].
+ 				cont _ cont sender.
+ 			]]]'; cr.
+ !

Item was added:
+ ----- Method: RecentMessageSet>>maybeSetSelection (in category '*Etoys-Squeakland-selection') -----
+ maybeSetSelection
+ 	"After a browser's message list is changed, this message is dispatched to the model, to give it a chance to refigure a selection"	
+ 	self messageListIndex: 1!

Item was added:
+ AlignmentMorph subclass: #RecordingControls
+ 	instanceVariableNames: 'recorder recordingStatusLight recordMeter recordingSaved'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sound-Interface'!
+ 
+ !RecordingControls commentStamp: 'sw 7/11/2007 18:12' prior: 0!
+ A facelifted version of John Maloney's original RecordingControlsMorph.!

Item was added:
+ ----- Method: RecordingControls class>>additionsToViewerCategories (in category 'as yet unclassified') -----
+ 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."
+ 
+ 	^ #((#'sound recorder'
+ 			((command recordButtonHit 'start recording')
+ 			(command stopButtonHit 'stop recording or playback')
+ 			(command playButtonHit 'play recording')
+   )))!

Item was added:
+ ----- Method: RecordingControls class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	"If the receiver is a member of a class that would like to be represented in a parts bin, answer the name by which it should be known, and a documentation string to be provided, for example, as balloon help."
+ 
+ 	^ self partName:	'SoundRecorder' translatedNoop
+ 		categories:		{'Multimedia' translatedNoop}
+ 		documentation:	'A device for making sound recordings.' translatedNoop!

Item was added:
+ ----- Method: RecordingControls class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"Class initialization."
+ 
+ 	self registerInFlapsRegistry!

Item was added:
+ ----- Method: RecordingControls class>>registerInFlapsRegistry (in category 'class initialization') -----
+ registerInFlapsRegistry
+ 	"Register the receiver in the system's flaps registry"
+ 	self environment
+ 		at: #Flaps
+ 		ifPresent: [:cl | cl registerQuad: {#RecordingControls. #authoringPrototype.	'Sound Recorder' translatedNoop. 'A device for making sound recordings.' translatedNoop}
+ 						forFlapNamed: 'PlugIn Supplies'.
+ 						cl registerQuad: {#RecordingControls. #authoringPrototype. 'Sound Recorder' translatedNoop. 'A device for making sound recordings.' translatedNoop}
+ 						forFlapNamed: 'Widgets'.]!

Item was added:
+ ----- Method: RecordingControls class>>unload (in category 'class initialization') -----
+ unload
+ 	"Unload the receiver from global registries"
+ 
+ 	self environment at: #Flaps ifPresent: [:cl |
+ 	cl unregisterQuadsWithReceiver: self] !

Item was added:
+ ----- Method: RecordingControls>>addButtonRows (in category 'initialization') -----
+ addButtonRows
+ 	"Add the row of buttons at the top of the tool."
+ 
+ 	| aWrapper aButton textButtons  maxWidth |
+ 	aWrapper _ AlignmentMorph newRow vResizing: #shrinkWrap.
+ 
+ 	aWrapper addMorphBack: self makeStatusLight.
+ 	aWrapper addTransparentSpacerOfSize: 6 @ 1.
+ 
+ 	aButton := self buttonName: 'Record' translated action: #recordButtonHit.
+ 	aButton setBalloonText: 'Start a new recording' translated.
+ 	aWrapper addMorphBack: aButton.
+ 	textButtons := OrderedCollection with: aButton.
+ 	aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ 
+ 	aButton := self buttonName: 'Stop' translated action: #stopButtonHit.
+ 	aButton setBalloonText: 'Stop current recording or playback' translated.
+ 	aWrapper addMorphBack: aButton.
+ 	textButtons add: aButton.
+ 	aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ 
+ 	aButton := self buttonName: 'Play' translated action: #playButtonHit.
+ 	aButton setBalloonText: 'Play the current recording from its beginning' translated.
+ 	aWrapper addMorphBack: aButton.
+ 	textButtons add: aButton.
+ 	aWrapper addTransparentSpacerOfSize: 16 @ 1.
+ 
+ 	aButton := self buttonName: 'Save' translated action: #saveButtonHit.
+ 	aButton setBalloonText: 'Save the current recording for future use.' translated.
+ 	aWrapper addMorphBack: aButton.
+ 	textButtons add: aButton.
+ 	aWrapper addTransparentSpacerOfSize: 8 @ 1.
+ 
+ 	aWrapper addMorphBack: self menuButton.
+ 
+ 	maxWidth := (textButtons collect: [:b | b width]) max.
+ 	textButtons do: [:b | b width: maxWidth].
+ 
+ 	self addMorphBack: aWrapper.
+ 	aWrapper layoutChanged.
+ 
+ 	^ aWrapper fullBounds extent!

Item was added:
+ ----- Method: RecordingControls>>addMenuButtonItemsTo: (in category 'initialization') -----
+ addMenuButtonItemsTo: aMenu
+ 	"The menu button was hit, and aMenu will be put up in response.  Populated the menu with the appropriate items."
+ 
+ 	aMenu title: 'Sound Recorder Options' translated.
+ 	aMenu addStayUpItem.
+ 
+ 	aMenu addUpdating: #durationString target: self selector: #yourself argumentList: #().
+ 
+ 	aMenu addTranslatedList: #(
+ 		-
+ 		('help'	putUpAndOpenHelpFlap 'opens a flap which contains instructions')
+ 		-
+ 		('hand me a sound token'		makeSoundMorph	'hands you a lozenge representing the current sound,  which you can drop into a piano-roll or an event-roll, or later add to the sound library.  Double-click on it to hear the sound')
+ 		-) translatedNoop.
+ 
+ 	Preferences eToyFriendly
+ 		ifFalse:
+ 			[aMenu addTranslatedList: #(
+ 				('trim'							trim	'remove any blanks space at the beginning and/or end of the recording.  Caution -- this feature seems to be broken, at least on some platforms, so use at your own risk.  For safety, save this sound in its untrimmed form before venturing to trim.')) translatedNoop].
+ 
+ 	aMenu addTranslatedList: #(
+ 				('choose compression...'	chooseCodec 	'choose which data-compression scheme should be used to encode the recording.')
+ 				('wave editor'					showEditor	'open up the wave-editor tool to visualize and to edit the sound recorded')) translatedNoop!

Item was added:
+ ----- Method: RecordingControls>>addRecordLevelSliderIn: (in category 'initialization') -----
+ addRecordLevelSliderIn: aPoint
+ 	"Add the slider that allows the record-level to be adjusted."
+ 
+ 	| levelSlider r aLabel |
+ 	levelSlider _ SimpleSliderMorph new
+ 		color: color darker;
+ 		extent: (aPoint x * 0.75) asInteger@(aPoint y*0.6) asInteger;
+ 		target: recorder;
+ 		actionSelector: #recordLevel:;
+ 		adjustToValue: recorder recordLevel.
+ 	levelSlider sliderBalloonHelp: 'Drag to set the record level' translated.
+ 	r _ AlignmentMorph newRow
+ 		color: color;
+ 		layoutInset: 0;
+ 		wrapCentering: #center; cellPositioning: #leftCenter;
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #rigid;
+ 		height: aPoint y + 2.
+ 	aLabel := StringMorph contents: '0 ' font:  ScriptingSystem fontForEToyButtons.
+ 	r addMorphBack: aLabel.
+ 	aLabel setBalloonText: 'minimum record-level' translated.
+ 	r addMorphBack: levelSlider.
+ 	aLabel := StringMorph contents: '10 ' font:  ScriptingSystem fontForEToyButtons.
+ 	aLabel setBalloonText: 'maximum record-level' translated.
+ 	r addMorphBack: aLabel.
+ 	self addMorphBack: r.
+ !

Item was added:
+ ----- Method: RecordingControls>>buttonName:action: (in category 'initialization') -----
+ buttonName: aString action: aSymbol
+ 	"Create a button with the given label and action selector, and answer it."
+ 
+ 	^ SimpleButtonMorph new
+ 		target: self;
+ 		label: aString font: ScriptingSystem fontForEToyButtons;
+ 		actionSelector: aSymbol
+ !

Item was added:
+ ----- Method: RecordingControls>>buttonWithSelector: (in category 'private') -----
+ buttonWithSelector: aSelector
+ 	"Answer the button in my button pane that bears the given selector."
+ 
+ 	^ submorphs first submorphs detect:
+ 		[:m | (m isKindOf: SimpleButtonMorph) and:
+ 			[m actionSelector = aSelector]]!

Item was added:
+ ----- Method: RecordingControls>>changeCodec:name: (in category 'private') -----
+ changeCodec: aClass name: aString 
+ 	"Use the supplied class as the supplier of the current codec, and call it by the name provided when needed for a menu item."
+ 
+ 	| button newLabel |
+ 	(aClass notNil and: [aClass isAvailable])
+ 		ifTrue:
+ 			[recorder codec: aClass new.
+ 			newLabel := aString]
+ 		ifFalse:
+ 			[newLabel := 'None'.
+ 			recorder codec: nil].
+ 
+ 	"The below is for when there is a button showing the compression..."
+ 	self submorphs
+ 		do: [:raw | raw submorphs
+ 				do: [:each | ((each isKindOf: SimpleButtonMorph)
+ 							and: [each actionSelector = #chooseCodec])
+ 						ifTrue: [button := each]]].
+ 
+ 	button ifNotNil: [button labelString: newLabel]!

Item was added:
+ ----- Method: RecordingControls>>chooseCodec (in category 'menu commands') -----
+ chooseCodec
+ 	"Put up a menu allowing the user to choose which codec to use."
+ 	| menu aName aCodec |
+ 	menu := MenuMorph new defaultTarget: self.
+ 	aCodec := recorder codec.
+ 	aName := aCodec
+ 				ifNil: ['None' translated]
+ 				ifNotNil: [aCodec class visibleCodecName].
+ 	menu title: ('Compression method\Currently: {1}' translated withCRs format: {aName}).
+ 	OggDriver isAvailable
+ 		ifTrue: [menu
+ 				add: 'Speex (for speech)' translated
+ 				target: self
+ 				selector: #changeCodec:name:
+ 				argumentList: {OggSpeexCodec. OggSpeexCodec visibleCodecName}.
+ 			menu
+ 				add: 'Vorbis (for music)' translated
+ 				target: self
+ 				selector: #changeCodec:name:
+ 				argumentList: {OggVorbisCodec. OggVorbisCodec visibleCodecName}].
+ 	menu
+ 		add: 'GSM (simple compression)' translated
+ 		target: self
+ 		selector: #changeCodec:name:
+ 		argumentList: {GSMCodec. GSMCodec visibleCodecName}.
+ 	menu
+ 		add: 'No compression' translated
+ 		target: self
+ 		selector: #changeCodec:name:
+ 		argumentList: {nil. 'None' translated}.
+ 	recorder codec
+ 		ifNil: [menu items last color: Color red]
+ 		ifNotNil: [menu items
+ 				do: [:itm | itm arguments first = recorder codec class
+ 						ifTrue: [itm color: Color red]]].
+ 	menu popUpInWorld!

Item was added:
+ ----- Method: RecordingControls>>delete (in category 'private') -----
+ delete
+ 	"Stop the recorder from recording or playing."
+ 	self stop.
+ 	self stopStepping.
+ 	^super delete
+ !

Item was added:
+ ----- Method: RecordingControls>>durationString (in category 'private') -----
+ durationString
+ 	"Answer a string representing my duration."
+ 
+ 	recorder ifNotNil:
+ 		[recorder recordedSound ifNotNilDo:
+ 			[:aSound | ^ 'Recorded sound duration: {1} second(s)' translated format: {(aSound duration printShowingDecimalPlaces: 2)}]].
+ 
+ 	^ 'no sound recorded yet' translated!

Item was added:
+ ----- Method: RecordingControls>>helpString (in category 'documentation') -----
+ helpString
+ 	"Answer a help string for the SoundRecorder"
+ 
+ 	^ '
+ Press "Record" to start recording.  Press Stop when finished recording.
+ 
+ After making a recording, you can:
+    Press "Play" to play back the recording.
+    Press "Record" to start a new recording
+       (the old one would be discarded).
+    Press "Save" to save the recording in the sound library.
+ 
+ Press the menu icon to get a menu with further options.
+ 
+ If you wish to refer to the sound in scripts, you need to add it to the sound library; press Save to do that; you will need to supply a name for it.
+ 
+ If you want to retain the sound but do not need to refer to it in scripts, you need not name it; instead, use "hand me a sound token", found in the menu, to obtain a little "sound token" object that you can subsequently use in a variety of ways:
+   You can double-click on the sound token to hear the sound again.
+   You can decide to save the sound after all, by using an item in the sound token''s halo menu.
+   You can drop the sound token into a PianoRoll or an EventRoll.
+ ' translated!

Item was added:
+ ----- Method: RecordingControls>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver."
+ 
+ 	| r full |
+ 	super initialize.
+ 	self hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ 	borderWidth _ 2.
+ 	self listDirection: #topToBottom.
+ 	recorder _ SoundRecorder new.
+ 	recordingSaved := false.
+ 	full := self addButtonRows.
+ 	self changeCodec: OggSpeexCodec name: 'Speex'.
+ 
+ 	"self addRecordLevelSliderIn: full."  "Doesn't work in most or maybe even all platforms..."
+ 
+ 	r _ AlignmentMorph newRow vResizing: #shrinkWrap.
+ 	r addMorphBack: (self makeRecordMeterIn: full).
+ 	self addMorphBack: r.
+ 	self extent: 10 at 10.  "make minimum size"
+ 	self setButtonEnablement
+ !

Item was added:
+ ----- Method: RecordingControls>>justTornOffFromPartsBin (in category 'documentation') -----
+ justTornOffFromPartsBin
+ 	"A notification that the receiver was just torn off from a supplies flap, objects catalogue, or other parts factory; intercept this message to put up a help flap, for example."
+ 
+ 	"self putUpHelpFlap"!

Item was added:
+ ----- Method: RecordingControls>>makeRecordMeterIn: (in category 'initialization') -----
+ makeRecordMeterIn: aPoint
+ 	"Create the morph that will serve as the receiver's record meter, using the given point for its extent."
+ 
+ 	| outerBox h |
+ 	h := (aPoint y * 0.6) asInteger.
+ 	outerBox _ Morph new extent: (aPoint x) asInteger at h; color: Color gray.
+ 	recordMeter _ Morph new extent: 1 at h; color: Color yellow.
+ 	recordMeter position: outerBox topLeft + (1 at 1).
+ 	outerBox addMorph: recordMeter.
+ 	^ outerBox
+ !

Item was added:
+ ----- Method: RecordingControls>>makeSoundMorph (in category 'private') -----
+ makeSoundMorph
+ 	"Hand the user an anonymous-sound object  representing the receiver's sound."
+ 
+ 	| m aName |
+ 	recorder verifyExistenceOfRecordedSound ifFalse: [^ self].
+ 	recorder pause.
+ 	recordingSaved := true.
+ 	m _ AnonymousSoundMorph new.
+ 
+ 	m sound: recorder recordedSound interimName: (aName :=  'Unnamed Sound').
+ 
+ 	m setNameTo: aName.
+ 	ActiveHand attachMorph: m!

Item was added:
+ ----- Method: RecordingControls>>makeStatusLight (in category 'initialization') -----
+ makeStatusLight
+ 	"Make the recordingStatusLight, plce it in the #recordingStatusLight instance variable, and answer it.  It is the responsibility of the sender to add it to the tool's structure."
+ 
+ 	recordingStatusLight _ EllipseMorph new extent: 24 at 24.
+ 	recordingStatusLight borderWidth: 1; borderColor: Color gray lighter.
+ 	recordingStatusLight color: Color transparent.
+ 	recordingStatusLight setBalloonText: 'When red, it means you are currently recording' translated.
+ 	^ recordingStatusLight
+ !

Item was added:
+ ----- Method: RecordingControls>>playButtonHit (in category 'button commands') -----
+ playButtonHit
+ 	"The user hit the play button."
+ 
+ 	recorder verifyExistenceOfRecordedSound ifFalse: [^ self].  "will have put up informer"
+ 	(self buttonWithSelector: #stopButtonHit) setAppearanceForEnablement: true.
+ 	(self buttonWithSelector: #playButtonHit) setAppearanceForEnablement: true.
+ 	(self buttonWithSelector: #saveButtonHit) setAppearanceForEnablement: true.
+ 
+ 	self playback!

Item was added:
+ ----- Method: RecordingControls>>playback (in category 'private') -----
+ playback
+ 	"The user hit the playback button"
+ 
+ 	recorder verifyExistenceOfRecordedSound ifFalse: [^ self].
+ 	recorder pause.
+ 	recorder playback.
+ !

Item was added:
+ ----- Method: RecordingControls>>putUpAndOpenHelpFlap (in category 'documentation') -----
+ putUpAndOpenHelpFlap
+ 	"If appropriate, put up (if not already present) a flap giving documentation"
+ 
+ 	| aFlap |
+ 	aFlap := ScriptingSystem assureFlapOfLabel: 'Sound Recorder' translated withContents: self helpString.
+ 	aFlap showFlap
+ !

Item was added:
+ ----- Method: RecordingControls>>putUpHelpFlap (in category 'documentation') -----
+ putUpHelpFlap
+ 	"If appropriate, put up (if not alredy present) a flap giving documentation"
+ 
+ 	(ScriptingSystem assureFlapOfLabel: 'Sound Recorder' translated withContents: self helpString)
+ 		hideFlap
+ !

Item was added:
+ ----- Method: RecordingControls>>record (in category 'private') -----
+ record
+ 	"Start the recorder."
+ 
+ 	recorder clearRecordedSound.
+ 	recordingSaved := false.
+ 	recorder resumeRecording.
+ !

Item was added:
+ ----- Method: RecordingControls>>recordButtonHit (in category 'button commands') -----
+ recordButtonHit
+ 	"The user hit the record button."
+ 
+ 	(self buttonWithSelector: #stopButtonHit) setAppearanceForEnablement: true.
+ 	self record.!

Item was added:
+ ----- Method: RecordingControls>>recorder (in category 'private') -----
+ recorder
+ 	"Answer the receiver's recorder."
+ 
+ 	^ recorder
+ !

Item was added:
+ ----- Method: RecordingControls>>saveAnonymousSound (in category 'private') -----
+ saveAnonymousSound
+ 	"Save the recorded sound in a so-called 'anonymous sound tile'.  Such a tile holds the actual sound, rather than a reference to an element of the sound library."
+ 
+ 	| aTile |
+ 	self flag: #deferred.
+ 	true ifTrue: [^ self makeSoundMorph].
+ 	"When other issues are solved, cut over to the below...
+ 
+ 	aTile := AnonymousSoundTile new.
+ 	aTile actualSound: recorder recordedSound.
+ 	aTile emblazonAppropriateLabel.
+ 	aTile bounds: aTile fullBounds.
+ 	aTile openInHand"!

Item was added:
+ ----- Method: RecordingControls>>saveButtonHit (in category 'button commands') -----
+ saveButtonHit
+ 	"The user hit the 'save' button."
+ 
+ 	| sndName tile |
+ 	recorder verifyExistenceOfRecordedSound ifFalse: [^ self].
+ 	recorder pause.
+ 
+ 	sndName _ FillInTheBlank
+ 				request: 'Sound name?' translated
+ 				initialAnswer: 'unnamed' translated .
+ 			sndName isEmpty ifTrue: [^ self].
+ 			sndName = 'unnamed' translated
+ 				ifTrue:
+ 					[^ self saveAnonymousSound].
+ 
+ 	sndName _ SampledSound unusedSoundNameLike: sndName.
+ 	recorder codecSignature
+ 		ifNil: [SampledSound
+ 			addLibrarySoundNamed: sndName
+ 			samples: recorder condensedSamples
+ 			samplingRate: recorder samplingRate]
+ 		ifNotNil: [SampledSound
+ 			addLibrarySoundNamed: sndName
+ 			bytes: recorder condensedChannels
+ 			codecSignature: recorder codecSignature].
+ 
+ 	recordingSaved := true.
+ 
+ 	tile _ SoundTile new literal: sndName.
+ 	tile bounds: tile fullBounds.
+ 	tile openInHand!

Item was added:
+ ----- Method: RecordingControls>>setButtonEnablement (in category 'private') -----
+ setButtonEnablement
+ 	"Enable my buttons."
+ 
+ 	| exists aButton mySound recordingOrPlaying |
+ 	exists := (mySound := recorder recordedSound) notNil.
+ 	exists
+ 		ifTrue:
+ 			[aButton := self buttonWithSelector: #recordButtonHit.
+ 			aButton setBalloonText: 'Discard the current recording and start making a fresh recording' translated.
+ 			recordingOrPlaying := mySound isPlaying or: [recorder isPaused not]]
+ 		ifFalse:
+ 			[recordingOrPlaying := false].
+ 	(self buttonWithSelector: #stopButtonHit) setAppearanceForEnablement: recordingOrPlaying.
+ 	(self buttonWithSelector: #playButtonHit) setAppearanceForEnablement: exists.
+ 	(self buttonWithSelector: #saveButtonHit) setAppearanceForEnablement: exists.
+ !

Item was added:
+ ----- Method: RecordingControls>>showEditor (in category 'menu commands') -----
+ showEditor
+ 	"Show my samples in a WaveEditor."
+ 
+ 	| ed w |
+ 	recorder verifyExistenceOfRecordedSound ifFalse: [^ self].
+ 	recorder pause.
+ 	ed _ WaveEditor new.
+ 	ed data: recorder condensedSamples.
+ 	ed samplingRate: recorder samplingRate.
+ 	w _ self world.
+ 	w activeHand
+ 		ifNil: [w addMorph: ed]
+ 		ifNotNil: [w activeHand attachMorph: ed].
+ 
+ !

Item was added:
+ ----- Method: RecordingControls>>startStepping (in category 'stepping') -----
+ startStepping
+ 	"Make the level meter active when dropped into the world. Do nothing if already recording. Note that this will cause other recorders to stop recording..."
+ 
+ 	super startStepping.
+ 	recorder isPaused ifTrue: [
+ 		SoundRecorder allSubInstancesDo: [:r | r stopRecording].  "stop all other sound recorders"
+ 		recorder pause].  "meter is updated while paused"
+ !

Item was added:
+ ----- Method: RecordingControls>>step (in category 'stepping') -----
+ step
+ 	"Periodic action.  Assure that the status light and recordMeter properly reflect the state of the recorder."
+ 
+ 	recorder isPaused
+ 		ifTrue: [recordingStatusLight color: Color transparent]
+ 		ifFalse: [recordingStatusLight color: Color red].
+ 	recordMeter extent: (recorder meterLevel + 1) @ recordMeter height.
+ !

Item was added:
+ ----- Method: RecordingControls>>stepTime (in category 'stepping') -----
+ stepTime
+ 	"Answer the desired time between steps in milliseconds."
+ 
+ 	^ 50
+ !

Item was added:
+ ----- Method: RecordingControls>>stop (in category 'private') -----
+ stop
+ 	"Stop the recorder from recording or playing."
+ 
+ 	recorder pause
+ !

Item was added:
+ ----- Method: RecordingControls>>stopButtonHit (in category 'button commands') -----
+ stopButtonHit
+ 	"The user hit the stop button."
+ 
+ 	recorder verifyExistenceOfRecordedSound ifFalse: [^ self].
+ 	self stop.
+ 	self setButtonEnablement.  "But in case it hasn't got the word..."
+ 	(self buttonWithSelector: #stopButtonHit) setAppearanceForEnablement: false
+ !

Item was added:
+ ----- Method: RecordingControls>>stopStepping (in category 'stepping') -----
+ stopStepping
+ 	"Turn off recording."
+ 
+ 	super stopStepping.
+ 	recorder stopRecording.
+ !

Item was added:
+ ----- Method: RecordingControls>>trim (in category 'menu commands') -----
+ trim
+ 	"Show my samples in a GraphMorph."
+ 	
+ 	| oldDuration newDuration delta msg |
+ 	recorder verifyExistenceOfRecordedSound ifFalse: [^ self].
+ 	recorder pause.
+ 	recordingSaved ifFalse:
+ 		[(self confirm: 'Caution:  this is dangerous and destructive!!
+ Do you really want to "trim" your recording?
+ (It might be smart to save the untrimmed
+ version in a sound token before trimming)' translated) ifFalse: [^ self]].
+ 
+ 	oldDuration := recorder recordedSound duration.
+ 	recorder trim: 1400 normalizedVolume: 80.0.
+ 	newDuration := recorder recordedSound duration.
+ 	delta := oldDuration - newDuration.
+ 	delta > 0
+ 		ifTrue:
+ 			[recordingSaved := false.
+ 			msg := (delta printShowingDecimalPlaces: 3), ' second(s) trimmed' translated]
+ 		ifFalse:
+ 			[msg := 'unable to trim any more, sorry' translated].
+ 	self inform: msg!

Item was added:
+ ----- Method: RecordingControls>>updateReferencesUsing: (in category 'copying') -----
+ updateReferencesUsing: aDictionary
+ 	"Copy my recorder."
+ 
+ 	super updateReferencesUsing: aDictionary.
+ 	recorder _ SoundRecorder new.
+ !

Item was added:
+ ----- Method: RecordingControlsMorph class>>formerDescriptionForPartsBin (in category '*Etoys-Squeakland-parts bin') -----
+ formerDescriptionForPartsBin
+ 	"Answer the former description of the original sound-recorder for the parts bin."
+ 
+ 	^ self partName:	'SoundRecorder' translatedNoop
+ 		categories:		{'Multimedia' translatedNoop}
+ 		documentation:	'A device for making sound recordings.' translatedNoop!

Item was added:
+ ----- Method: RecordingControlsMorph>>addRecordLevelSliderIn: (in category '*Etoys-Squeakland-other') -----
+ addRecordLevelSliderIn: aPoint
+ 
+ 	| levelSlider r |
+ 	levelSlider _ SimpleSliderMorph new
+ 		color: color darker;
+ 		extent: (aPoint x * 0.75) asInteger@(aPoint y*0.6) asInteger;
+ 		target: recorder;
+ 		actionSelector: #recordLevel:;
+ 		adjustToValue: recorder recordLevel.
+ 	r _ AlignmentMorph newRow
+ 		color: color;
+ 		layoutInset: 0;
+ 		wrapCentering: #center; cellPositioning: #leftCenter;
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #rigid;
+ 		height: aPoint y + 2.
+ 	r addMorphBack: (StringMorph contents: '0 ' font: Preferences standardButtonFont).
+ 	r addMorphBack: levelSlider.
+ 	r addMorphBack: (StringMorph contents: ' 10' font: Preferences standardButtonFont).
+ 	self addMorphBack: r.
+ !

Item was added:
+ ----- Method: RecordingControlsMorph>>changeCodec:name: (in category '*Etoys-Squeakland-button commands') -----
+ changeCodec: aClass name: aString 
+ 	| button newLabel |
+ 	(aClass notNil
+ 			and: [aClass isAvailable])
+ 		ifTrue: [recorder codec: aClass new.
+ 			newLabel := aString]
+ 		ifFalse: [newLabel := 'None'].
+ 	self submorphs
+ 		do: [:raw | raw submorphs
+ 				do: [:each | ((each isKindOf: SimpleButtonMorph)
+ 							and: [each actionSelector = #chooseCodec])
+ 						ifTrue: [button := each]]].
+ 	button labelString: newLabel!

Item was added:
+ ----- Method: RecordingControlsMorph>>chooseCodec (in category '*Etoys-Squeakland-button commands') -----
+ chooseCodec
+ 	| menu |
+ 	menu := MenuMorph new defaultTarget: self.
+ 	OggDriver isAvailable
+ 		ifTrue: [menu
+ 				add: 'Speex'
+ 				target: self
+ 				selector: #changeCodec:name:
+ 				argumentList: {OggSpeexCodec. 'Speex'}.
+ 			menu
+ 				add: 'Vorbis'
+ 				target: self
+ 				selector: #changeCodec:name:
+ 				argumentList: {OggVorbisCodec. 'Vorbis'}].
+ 	menu
+ 		add: 'GSM'
+ 		target: self
+ 		selector: #changeCodec:name:
+ 		argumentList: {GSMCodec. 'GSM'}.
+ 	menu
+ 		add: 'None'
+ 		target: self
+ 		selector: #changeCodec:name:
+ 		argumentList: {nil. 'None'}.
+ 	menu popUpInWorld!

Item was added:
+ ----- Method: RecordingControlsMorph>>makeRecordMeterIn: (in category '*Etoys-Squeakland-other') -----
+ makeRecordMeterIn: aPoint
+ 
+ 	| outerBox h |
+ 	h := (aPoint y * 0.6) asInteger.
+ 	outerBox _ Morph new extent: (aPoint x) asInteger at h; color: Color gray.
+ 	recordMeter _ Morph new extent: 1 at h; color: Color yellow.
+ 	recordMeter position: outerBox topLeft + (1 at 1).
+ 	outerBox addMorph: recordMeter.
+ 	^ outerBox
+ !

Item was added:
+ ----- Method: RecordingControlsMorph>>showEditor (in category '*Etoys-Squeakland-button commands') -----
+ showEditor
+ 	"Show my samples in a WaveEditor."
+ 
+ 	| ed w |
+ 	recorder verifyExistenceOfRecordedSound ifFalse: [^ self].
+ 	recorder pause.
+ 	ed _ WaveEditor new.
+ 	ed data: recorder condensedSamples.
+ 	ed samplingRate: recorder samplingRate.
+ 	w _ self world.
+ 	w activeHand
+ 		ifNil: [w addMorph: ed]
+ 		ifNotNil: [w activeHand attachMorph: ed].
+ 
+ !

Item was added:
+ ----- Method: Rectangle>>hashMappedBy: (in category '*Etoys-Squeakland-comparing') -----
+ hashMappedBy: map
+ 	"My hash is independent of my oop."
+ 
+ 	^self hash!

Item was added:
+ ----- Method: Rectangle>>intersectsAny: (in category '*Etoys-Squeakland-testing') -----
+ intersectsAny: rectangleList 
+ 	"Answer whether aRectangle intersects any of a list of other rectangles."
+ 
+ 	rectangleList do: [:r | (self intersects: r) ifTrue: [^ true]].
+ 	^ false!

Item was added:
+ ----- Method: RemoteFileStream>>converter: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ converter: aConverter
+ !

Item was added:
+ ClassCategoryReader subclass: #RenamedClassSourceReader
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Kernel-Classes'!

Item was added:
+ ----- Method: RenamedClassSourceReader class>>formerClassName:methodsFor:stamp: (in category 'as yet unclassified') -----
+ formerClassName: formerClassName methodsFor: aCategory stamp: aString
+ 
+ 	^self new
+ 		setClass: formerClassName 
+ 		category: aCategory 
+ 		changeStamp: aString!

Item was added:
+ ----- Method: RenamedClassSourceReader class>>scanner (in category 'as yet unclassified') -----
+ scanner
+ 
+ 	^self new!

Item was added:
+ ----- Method: RenamedClassSourceReader>>scanFrom: (in category 'as yet unclassified') -----
+ scanFrom: aStream
+ 
+ 	self flag: #bob. 	"should this ever happen?"
+ 	self halt.!

Item was added:
+ ----- Method: RenamedClassSourceReader>>scanFromNoCompile: (in category 'as yet unclassified') -----
+ scanFromNoCompile: aStream
+ 
+ 	self flag: #bob. 	"should this ever happen?"
+ 	self halt.!

Item was added:
+ ----- Method: RenamedClassSourceReader>>scanFromNoCompile:forSegment: (in category 'as yet unclassified') -----
+ scanFromNoCompile: aStream forSegment: anImageSegment
+ 	"Just move the source code for the methods from aStream."
+ 	| methodText d |
+ 
+ 	[
+ 		(methodText _ aStream nextChunkText) size > 0
+ 	] whileTrue: [
+ 		(SourceFiles at: 2) ifNotNil: [
+ 			d _ Dictionary new.
+ 			d
+ 				at: #oldClassName put: class;		"may be 'Player1' or 'Player1 class'"
+ 				at: #methodText put: methodText;
+ 				at: #changeStamp put: changeStamp;
+ 				at: #category put: category.
+ 			anImageSegment acceptSingleMethodSource: d.
+ 		]
+ 	]!

Item was added:
+ Notification subclass: #RequestAlternateSyntaxSetting
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Exceptions Kernel'!
+ 
+ !RequestAlternateSyntaxSetting commentStamp: '<historical>' prior: 0!
+ I provide a way to override the current setting of the alternate syntax preference. I am used when filing in code to insure that the Smalltalk-80 preference is used regardless of what the user likes to see in her browsers.!

Item was added:
+ ----- Method: RequestAlternateSyntaxSetting>>defaultAction (in category 'as yet unclassified') -----
+ defaultAction
+ 
+         self resume: Preferences printAlternateSyntax!

Item was added:
+ ----- Method: ReturnNode>>defaultBlockType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultBlockType: t1 
+ 	^ #default!

Item was added:
+ ----- Method: ReturnNode>>defaultMessageType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultMessageType
+ 	^ #none!

Item was added:
+ ----- Method: ReturnNode>>emitForReturn:on: (in category '*Etoys-Squeakland-code generation') -----
+ emitForReturn: stack on: strm
+ 
+ 	expr emitForReturn: stack on: strm.
+ 	pc _ strm position!

Item was added:
+ ----- Method: ReturnNode>>emitForValue:on: (in category '*Etoys-Squeakland-code generation') -----
+ emitForValue: stack on: strm
+ 
+ 	expr emitForReturn: stack on: strm.
+ 	pc _ strm position!

Item was added:
+ ----- Method: ReturnNode>>firstInReceivers: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ firstInReceivers: t1 
+ 	^ t1 first!

Item was added:
+ ----- Method: ReturnNode>>getAllChildren (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getAllChildren
+ 
+ 	^ Array with: expr.
+ !

Item was added:
+ ----- Method: ReturnNode>>getElderSiblingOf: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getElderSiblingOf: node
+ 
+ 	^ nil.
+ !

Item was added:
+ ----- Method: ReturnNode>>getFirstChild (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getFirstChild
+ 
+ 	^ expr.
+ !

Item was added:
+ ----- Method: ReturnNode>>getLastChild (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ getLastChild
+ 
+ 	^ expr.
+ !

Item was added:
+ ----- Method: ReturnNode>>isFirstChild: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isFirstChild: childNode
+ 
+ 	^ childNode = expr.
+ !

Item was added:
+ ----- Method: ReturnNode>>isLastChild: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ isLastChild: childNode
+ 
+ 	^ childNode = expr.
+ !

Item was added:
+ ----- Method: ReturnNode>>isStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isStmt: t1 
+ 	^ t1 = #top
+ 		or: [t1 = #condition]!

Item was added:
+ ----- Method: ReturnNode>>isTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTest: t1 parentNode: t2 
+ 	t1 = true
+ 		ifTrue: [^ true].
+ 	^ (t2 isMemberOf: MessageNode)
+ 		and: [t2 receiver = self
+ 				and: [t2 messageType value = #condition]]!

Item was added:
+ ----- Method: ReturnNode>>isTopStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmt: t1 
+ 	t1 = nil
+ 		ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: ReturnNode>>rcvr: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr: t1 
+ 	^ t1!

Item was added:
+ ----- Method: ReturnNode>>replaceNode:with: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ replaceNode: childNode with: newNode
+ 
+ 	childNode = expr ifTrue: [expr _ newNode].
+ !

Item was added:
+ ----- Method: ReturnNode>>sizeForReturn: (in category '*Etoys-Squeakland-code generation') -----
+ sizeForReturn: encoder
+ 
+ 	^expr sizeForReturn: encoder!

Item was added:
+ ----- Method: ReturnNode>>sizeForValue: (in category '*Etoys-Squeakland-code generation') -----
+ sizeForValue: encoder
+ 
+ 	^expr sizeForReturn: encoder!

Item was added:
+ ----- Method: ReturnNode>>thisNode (in category '*Etoys-Tweak-Kedama-Generated') -----
+ thisNode
+ 	^ self!

Item was added:
+ ----- Method: ReturnNode>>transfer: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 
+ 	^ t1!

Item was added:
+ ----- Method: ReturnNode>>visitBy: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ visitBy: visitor
+ 
+ 	visitor visit: self.
+ 	expr visitBy: visitor.
+ !

Item was added:
+ RectangleMorph subclass: #RulerMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Widgets'!

Item was added:
+ ----- Method: RulerMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName:	'Ruler' translatedNoop
+ 		categories:		#()
+ 		documentation:	'A rectangle which continuously reports its size in pixels' translatedNoop!

Item was added:
+ ----- Method: RulerMorph>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ "answer the default border width for the receiver"
+ 	^ 1!

Item was added:
+ ----- Method: RulerMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ "answer the default color/fill style for the receiver"
+ 	^ Color
+ 		r: 0.8
+ 		g: 1.0
+ 		b: 1.0!

Item was added:
+ ----- Method: RulerMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 
+ 	| s |
+ 	super drawOn: aCanvas.
+ 	s _ self width printString, 'x', self height printString.
+ 	aCanvas drawString: s in: (bounds insetBy: borderWidth + 5) font: nil color: Color red.
+ !

Item was added:
+ ----- Method: SMSqueakMap>>windowColorToUse (in category '*Etoys-Squeakland-model access') -----
+ windowColorToUse
+ 
+ 	^ self userInterfaceTheme uniformWindowColor ifNil: [Color veryVeryLightGray]!

Item was added:
+ AlignmentMorph subclass: #SameGame
+ 	instanceVariableNames: 'board scoreDisplay selectionDisplay helpText'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!
+ 
+ !SameGame commentStamp: '<historical>' prior: 0!
+ See SameGame>>helpString for an explanation of how to play!

Item was added:
+ ----- Method: SameGame class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName:	'Same' translatedNoop
+ 		categories:		{'Games' translatedNoop}
+ 		documentation:	'A board game implementedby Tim Olson, based on a game originally written for UNIX by Eiji Fukumoto.' translatedNoop!

Item was added:
+ ----- Method: SameGame>>board (in category 'access') -----
+ board
+ 
+ 	board ifNil:
+ 		[board _ SameGameBoard new
+ 			target: self;
+ 			actionSelector: #selection].
+ 	^ board!

Item was added:
+ ----- Method: SameGame>>board: (in category 'access') -----
+ board: aSameGameBoard
+ 
+ 	board _ aSameGameBoard!

Item was added:
+ ----- Method: SameGame>>buildButton:target:label:selector: (in category 'initialization') -----
+ buildButton: aButton target: aTarget label: aLabel selector: aSelector
+ 	"wrap a button or switch in an alignmentMorph to allow a row of buttons to fill space"
+ 
+ 	| a |
+ 	aButton 
+ 		target: aTarget;
+ 		label: aLabel;
+ 		actionSelector: aSelector;
+ 		borderColor: #raised;
+ 		borderWidth: 2;
+ 		color: color.
+ 	a _ AlignmentMorph newColumn
+ 		wrapCentering: #center; cellPositioning: #topCenter;
+ 		hResizing: #spaceFill;
+ 		vResizing: #shrinkWrap;
+ 		color: color.
+ 	a addMorph: aButton.
+ 	^ a
+ 
+ !

Item was added:
+ ----- Method: SameGame>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color lightGray!

Item was added:
+ ----- Method: SameGame>>help: (in category 'actions') -----
+ help: helpState
+ 
+ 	helpState
+ 		ifTrue: [self addMorphBack: self helpText]
+ 		ifFalse: [helpText delete]!

Item was added:
+ ----- Method: SameGame>>helpString (in category 'access') -----
+ helpString
+ 	^ 'The object of SameGame is to maximize your score by removing tiles from the board.  Tiles are selected and removed by clicking on a tile that has at least one adjacent tile of the same color (where adjacent is defined as up, down, left, or right).
+ 
+ The first click selects a group of adjacent tiles, a second click in that group will remove it from the board, sliding tiles down and right to fill the space of the removed group.  If you wish to select a different group, simply click on it instead.
+ 
+ The score increases by "(selection - 2) squared", so you want to maximize the selection size as much as possible.  However, making small strategic selections may allow you to increase the size of a later selection.
+ 
+ If you are having a hard time finding a group, the "Hint" button will find one and select it for you (although it is likely not the best group to select!!).
+ 
+ When there are no more groups available, the score display will flash with your final score.  Your final score is reduced by 1 for each tile remaining on the board.  If you manage to remove all tiles, your final score is increased by a bonus of 5 times the number of tiles on a full board.
+ 
+ Come on, you can beat that last score!!  Click "New game"  ;-)
+ 
+ SameGame was originally written by Eiji Fukumoto for UNIX and X; this version is based upon the same game concept, but was rewritten from scratch.' translated!

Item was added:
+ ----- Method: SameGame>>helpText (in category 'access') -----
+ helpText
+ 
+ 	helpText ifNil:
+ 		[helpText _ PluggableTextMorph new
+ 			width: board width;
+ 			editString: self helpString].
+ 	^ helpText!

Item was added:
+ ----- Method: SameGame>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	self listDirection: #topToBottom;
+ 	  wrapCentering: #center;
+ 		 cellPositioning: #topCenter;
+ 	  vResizing: #shrinkWrap;
+ 	  hResizing: #shrinkWrap;
+ 	  layoutInset: 3;
+ 	  addMorph: self makeControls;
+ 	  addMorph: self board.
+ 	helpText _ nil.
+ 	self newGame!

Item was added:
+ ----- Method: SameGame>>makeControls (in category 'initialization') -----
+ makeControls
+ 
+ 	| row |
+ 	row _ AlignmentMorph newRow
+ 		color: color;
+ 		borderWidth: 0;
+ 		layoutInset: 3.
+ 	row hResizing: #spaceFill; vResizing: #shrinkWrap; wrapCentering: #center; cellPositioning: #leftCenter; extent: 5 at 5.
+ 	row addMorph:
+ 		(self
+ 			buildButton: SimpleSwitchMorph new
+ 			target: self
+ 			label: 'Help' translated
+ 			selector: #help:).
+ 	row addMorph:
+ 		(self
+ 			buildButton: SimpleButtonMorph new
+ 			target: self
+ 			label: 'Quit' translated
+ 			selector: #delete).
+ 	row addMorph:
+ 		(self
+ 			buildButton: SimpleButtonMorph new
+ 			target: self board
+ 			label: 'Hint' translated
+ 			selector: #hint).
+ 	row addMorph:
+ 		(self
+ 			buildButton: SimpleButtonMorph new
+ 			target: self
+ 			label: 'New game' translated
+ 			selector: #newGame).
+ 	selectionDisplay _ LedMorph new
+ 		digits: 2;
+ 		extent: (2*10 at 15).
+ 	row addMorph: (self wrapPanel: selectionDisplay label: 'Selection:' translated).
+ 	scoreDisplay _ LedMorph new
+ 		digits: 4;
+ 		extent: (4*10 at 15).
+ 	row addMorph: (self wrapPanel: scoreDisplay label: 'Score:' translated).
+ 	^ row!

Item was added:
+ ----- Method: SameGame>>newGame (in category 'actions') -----
+ newGame
+ 
+ 	scoreDisplay value: 0; flash: false.
+ 	selectionDisplay value: 0.
+ 	self board resetBoard.!

Item was added:
+ ----- Method: SameGame>>scoreDisplay (in category 'access') -----
+ scoreDisplay
+ 
+ 	^ scoreDisplay!

Item was added:
+ ----- Method: SameGame>>selection (in category 'actions') -----
+ selection
+ 	"a selection was made on the board; get its count and update the displays"
+ 
+ 	| count score |
+ 	count := self board selectionCount.
+ 	count = 0 
+ 		ifTrue: 
+ 			[score := scoreDisplay value + (selectionDisplay value - 2) squared.
+ 			board findSelection ifNil: 
+ 					[count := board tilesRemaining.
+ 					score := count = 0 
+ 						ifTrue: [score + (5 * board rows * board columns)]
+ 						ifFalse: [score - count].
+ 					scoreDisplay flash: true].
+ 			scoreDisplay value: score].
+ 	selectionDisplay value: count!

Item was added:
+ ----- Method: SameGame>>wrapPanel:label: (in category 'initialization') -----
+ wrapPanel: anLedPanel label: aLabel
+ 	"wrap an LED panel in an alignmentMorph with a label to its left"
+ 
+ 	| a |
+ 	a _ AlignmentMorph newRow
+ 		wrapCentering: #center; cellPositioning: #leftCenter;
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #shrinkWrap;
+ 		borderWidth: 0;
+ 		layoutInset: 3;
+ 		color: color lighter.
+ 	a addMorph: anLedPanel.
+ 	a addMorph: (StringMorph contents: aLabel). 
+ 	^ a
+ 
+ !

Item was added:
+ AlignmentMorph subclass: #SameGameBoard
+ 	instanceVariableNames: 'protoTile rows columns palette selection selectionColor flashColor flash target actionSelector arguments'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!
+ 
+ !SameGameBoard commentStamp: '<historical>' prior: 0!
+ I am an MxN array of SameGameTiles, and implement most of the logic to play the SameGame, including adjacent tile selection and removal.!

Item was added:
+ ----- Method: SameGameBoard class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 
+ 	^false!

Item was added:
+ ----- Method: SameGameBoard>>acceptDroppingMorph:event: (in category 'layout') -----
+ acceptDroppingMorph: aMorph event: evt
+ 	"Allow the user to set the protoTile just by dropping it on this morph."
+ 
+ 	self protoTile: aMorph.
+ 	self removeAllMorphs.
+ !

Item was added:
+ ----- Method: SameGameBoard>>actionSelector (in category 'accessing') -----
+ actionSelector
+ 
+ 	^ actionSelector!

Item was added:
+ ----- Method: SameGameBoard>>actionSelector: (in category 'accessing') -----
+ actionSelector: aSymbolOrString
+ 
+ 	(nil = aSymbolOrString or:
+ 	 ['nil' = aSymbolOrString or:
+ 	 [aSymbolOrString isEmpty]])
+ 		ifTrue: [^ actionSelector _ nil].
+ 
+ 	actionSelector _ aSymbolOrString asSymbol.
+ !

Item was added:
+ ----- Method: SameGameBoard>>adjustTiles (in category 'private') -----
+ adjustTiles
+ 	"add or remove new protoTile submorphs to fill out my new bounds"
+ 
+ 	| newSubmorphs requiredSubmorphs count r c |
+ 	columns _ self width // protoTile width.
+ 	rows _ self height // protoTile height.
+ 	requiredSubmorphs _ rows * columns.
+ 	newSubmorphs _ OrderedCollection new.
+ 	r _ 0.
+ 	c _ 0.
+ 	self submorphCount > requiredSubmorphs
+ 		ifTrue: "resized smaller -- delete rows or columns"
+ 			[count _ 0.
+ 			submorphs do:
+ 				[:m | 
+ 				count < requiredSubmorphs
+ 					ifTrue:
+ 						[m position: self position + (protoTile extent * (c @ r)).
+ 						m arguments: (Array with: c @ r).
+ 						newSubmorphs add: m]
+ 					ifFalse: [m privateOwner: nil].
+ 				count _ count + 1.
+ 				c _ c + 1.
+ 				c >= columns ifTrue: [c _ 0. r _ r + 1]]]
+ 		ifFalse: "resized larger -- add rows or columns"
+ 			[submorphs do:
+ 				[:m |
+ 				m position: self position + (self protoTile extent * (c @ r)).
+ 				m arguments: (Array with: c @ r).
+ 				newSubmorphs add: m.
+ 				c _ c + 1.
+ 				c >= columns ifTrue: [c _ 0. r _ r + 1]].
+ 			1 to: (requiredSubmorphs - self submorphCount) do:
+ 				[:m |
+ 				newSubmorphs add:
+ 					(protoTile copy
+ 						position: self position + (self protoTile extent * (c @ r));
+ 						actionSelector: #tileClickedAt:newSelection:;
+ 						arguments: (Array with: c @ r);
+ 						target: self;
+ 						privateOwner: self).
+ 				c _ c + 1.
+ 				c >= columns ifTrue: [c _ 0. r _ r + 1]]].
+ 	submorphs _ newSubmorphs asArray.
+ !

Item was added:
+ ----- Method: SameGameBoard>>capturedState (in category 'undo') -----
+ capturedState
+ 	"Note the state stored in the second element is an array of associations
+ 	from submorph index to a shallowCopy of the morph, but only for those
+ 	morphs that change.  Therefore the capturedState record *first* delivers
+ 	all the morphs, and *then* computes the difference and stores this back.
+ 	In the end, both undo and redo records follow this format."
+ 
+ 	| prior state oldMorphs priorChanges newChanges |
+ 	(prior := self valueOfProperty: #priorState) isNil 
+ 		ifTrue: 
+ 			[state := { 
+ 						self shallowCopy.	"selection, etc."
+ 						self submorphs collect: [:m | m shallowCopy].	"state of all tiles"
+ 						owner scoreDisplay flash.	"score display"
+ 						owner scoreDisplay value}.
+ 			self setProperty: #priorState toValue: state.
+ 			^state].
+ 	oldMorphs := prior second.
+ 	priorChanges := OrderedCollection new.
+ 	newChanges := OrderedCollection new.
+ 	1 to: oldMorphs size
+ 		do: 
+ 			[:i | 
+ 			(oldMorphs at: i) color = (submorphs at: i) color 
+ 				ifFalse: 
+ 					[priorChanges addLast: i -> (oldMorphs at: i).
+ 					newChanges addLast: i -> (submorphs at: i) shallowCopy]].
+ 	self removeProperty: #priorState.
+ 	prior at: 2 put: priorChanges asArray.	"Store back into undo state.2"
+ 	^{ 
+ 		self shallowCopy.	"selection, etc."
+ 		newChanges asArray.	"state of tiles that changed"
+ 		owner scoreDisplay flash.	"score display"
+ 		owner scoreDisplay value}!

Item was added:
+ ----- Method: SameGameBoard>>collapseColumn:fromRow: (in category 'actions') -----
+ collapseColumn: col fromRow: row
+ 
+ 	| targetTile sourceTile |
+ 	(targetTile _ self tileAt: col at row) disabled ifTrue:
+ 		[row - 1 to: 0 by: -1 do:
+ 			[:r |
+ 			(sourceTile _ self tileAt: col at r) disabled ifFalse:
+ 				[targetTile color: sourceTile color.
+ 				targetTile disabled: false.
+ 				sourceTile disabled: true.
+ 				^ true]]].
+ 	^ false
+ !

Item was added:
+ ----- Method: SameGameBoard>>collapseColumns: (in category 'actions') -----
+ collapseColumns: columnsToCollapse
+ 
+ 	| columnsToRemove |
+ 	columnsToRemove _ OrderedCollection new.
+ 	columnsToCollapse do:
+ 		[:c |
+ 		rows - 1 to: 0 by: -1 do: [:r | self collapseColumn: c fromRow: r].
+ 		(self tileAt: c@(rows-1)) disabled ifTrue: [columnsToRemove add: c]].
+ 	self world displayWorld.
+ 	columnsToRemove reverseDo: [:c | self removeColumn: c].
+ !

Item was added:
+ ----- Method: SameGameBoard>>columns (in category 'accessing') -----
+ columns
+ 
+ 	^ columns!

Item was added:
+ ----- Method: SameGameBoard>>columns: (in category 'accessing') -----
+ columns: newColumns
+ 
+ 	self extent: self protoTile extent * (newColumns @ rows)!

Item was added:
+ ----- Method: SameGameBoard>>columns:rows: (in category 'accessing') -----
+ columns: newColumns rows: newRows
+ 
+ 	self extent: self protoTile extent * (newColumns @ newRows)!

Item was added:
+ ----- Method: SameGameBoard>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ 	"answer the default border width for the receiver"
+ 	^ 2!

Item was added:
+ ----- Method: SameGameBoard>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color gray!

Item was added:
+ ----- Method: SameGameBoard>>deselectSelection (in category 'actions') -----
+ deselectSelection
+ 
+ 	selection ifNotNil:
+ 		[selection do: [:loc | (self tileAt: loc) setSwitchState: false; color: selectionColor].
+ 		selection _ nil.
+ 		flash _ false]!

Item was added:
+ ----- Method: SameGameBoard>>extent: (in category 'geometry') -----
+ extent: aPoint
+ 	"constrain the extent to be a multiple of the protoTile size during resizing"
+ 	super extent: (aPoint truncateTo: protoTile extent).
+ 	self adjustTiles.!

Item was added:
+ ----- Method: SameGameBoard>>findSelection (in category 'actions') -----
+ findSelection
+ 	"find a possible selection and return it, or nil if no selection"
+ 
+ 	| tile k testTile |
+ 	0 to: rows-1 do:
+ 		[:r |
+ 		0 to: columns-1 do:
+ 			[:c |
+ 			tile _ self tileAt: c at r.
+ 			tile disabled  ifFalse:
+ 				[k _ tile color.
+ 				c+1 < columns ifTrue:
+ 					[testTile _ self tileAt: (c+1)@r.
+ 					(testTile disabled not and: [testTile color = k]) ifTrue: [^ tile]].
+ 				r+1 < rows ifTrue:
+ 					[testTile _ self tileAt: c@(r+1).
+ 					(testTile disabled not and: [testTile color = k]) ifTrue: [^ tile]]]]].
+ 	 ^ nil
+ 			!

Item was added:
+ ----- Method: SameGameBoard>>hint (in category 'actions') -----
+ hint
+ 	"find a possible selection and select it"
+ 
+ 	| tile |
+ 	self deselectSelection.
+ 	tile _ self findSelection.
+ 	tile ifNotNil: [tile mouseDown: MouseButtonEvent new]!

Item was added:
+ ----- Method: SameGameBoard>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	target _ nil.
+ 	actionSelector _ #selection.
+ 	arguments _ #().
+ 	self layoutPolicy: nil.
+ 	self hResizing: #rigid.
+ 	self vResizing: #rigid.
+ 	rows _ self preferredRows.
+ 	columns _ self preferredColumns.
+ 
+ 	palette _ (Color wheel: self preferredTileTypes + 1) asOrderedCollection.
+ 	flashColor _ palette removeLast.
+ 	flash _ false.
+ 	self extent: self protoTile extent * (columns @ rows).
+ 	self resetBoard!

Item was added:
+ ----- Method: SameGameBoard>>preferredColumns (in category 'preferences') -----
+ preferredColumns
+ 
+ 	^ 20!

Item was added:
+ ----- Method: SameGameBoard>>preferredRows (in category 'preferences') -----
+ preferredRows
+ 
+ 	^ 10!

Item was added:
+ ----- Method: SameGameBoard>>preferredTileTypes (in category 'preferences') -----
+ preferredTileTypes
+ 
+ 	^ 5!

Item was added:
+ ----- Method: SameGameBoard>>protoTile (in category 'accessing') -----
+ protoTile
+ 
+ 	protoTile ifNil: [protoTile _ SameGameTile new].
+ 	^ protoTile!

Item was added:
+ ----- Method: SameGameBoard>>protoTile: (in category 'accessing') -----
+ protoTile: aTile
+ 
+ 	protoTile _ aTile!

Item was added:
+ ----- Method: SameGameBoard>>removeColumn: (in category 'actions') -----
+ removeColumn: column
+ 
+ 	| sourceTile |
+ 	column+1 to: columns-1 do:
+ 		[:c |
+ 		0 to: rows-1 do:
+ 			[:r |
+ 			sourceTile _ self tileAt: c at r.
+ 			(self tileAt: c-1 at r)
+ 				color: sourceTile color;
+ 				disabled: sourceTile disabled]].
+ 	0 to: rows-1 do:
+ 		[:r | (self tileAt: columns-1 at r) disabled: true]!

Item was added:
+ ----- Method: SameGameBoard>>removeSelection (in category 'actions') -----
+ removeSelection
+ 	selection
+ 		ifNil: [^ self].
+ 	self
+ 		rememberUndoableAction: [selection
+ 				do: [:loc | (self tileAt: loc) disabled: true;
+ 						 setSwitchState: false].
+ 			self collapseColumns: (selection
+ 					collect: [:loc | loc x]) asSet asSortedCollection.
+ 			selection := nil.
+ 			flash := false.
+ 			(target notNil
+ 					and: [actionSelector notNil])
+ 				ifTrue: [target perform: actionSelector withArguments: arguments]]
+ 		named: 'remove selection' translated!

Item was added:
+ ----- Method: SameGameBoard>>resetBoard (in category 'initialization') -----
+ resetBoard
+ 	Collection initialize.  "randomize"
+ 	selection _ nil.
+ 	self purgeAllCommands.
+ 	self submorphsDo:
+ 		[:m |
+ 		m disabled: false.
+ 		m setSwitchState: false.
+ 		m color: palette atRandom].
+ 
+ !

Item was added:
+ ----- Method: SameGameBoard>>rows (in category 'accessing') -----
+ rows
+ 
+ 	^ rows!

Item was added:
+ ----- Method: SameGameBoard>>rows: (in category 'accessing') -----
+ rows: newRows
+ 
+ 	self extent: self protoTile extent * (columns @ newRows)!

Item was added:
+ ----- Method: SameGameBoard>>selectTilesAdjacentTo: (in category 'actions') -----
+ selectTilesAdjacentTo: location
+ 
+ 	| al at |
+ 	{-1 at 0. 0 at -1. 1 at 0. 0 at 1} do:
+ 		[:offsetPoint |
+ 		al _ location + offsetPoint.
+ 		((al x between: 0 and: columns - 1) and: [al y between: 0 and: rows - 1]) ifTrue:
+ 			[at _ self tileAt: al.
+ 			(at color = selectionColor and: [at switchState not and: [at disabled not]]) ifTrue:
+ 				[selection add: al.
+ 				at setSwitchState: true.
+ 				self selectTilesAdjacentTo: al]]]
+ !

Item was added:
+ ----- Method: SameGameBoard>>selectionCount (in category 'accessing') -----
+ selectionCount
+ 
+ 	^ selection isNil
+ 		ifTrue: [0]
+ 		ifFalse: [selection size]!

Item was added:
+ ----- Method: SameGameBoard>>step (in category 'stepping and presenter') -----
+ step
+ 
+ 	| newColor |
+ 	selection ifNotNil:
+ 		[newColor _ flash
+ 			ifTrue: [selectionColor]
+ 			ifFalse: [flashColor].
+ 		selection do: [:loc | (self tileAt: loc) color: newColor].
+ 		flash _ flash not]
+ !

Item was added:
+ ----- Method: SameGameBoard>>stepTime (in category 'testing') -----
+ stepTime
+ 
+ 	^ 500!

Item was added:
+ ----- Method: SameGameBoard>>target (in category 'accessing') -----
+ target
+ 
+ 	^ target!

Item was added:
+ ----- Method: SameGameBoard>>target: (in category 'accessing') -----
+ target: anObject
+ 
+ 	target _ anObject!

Item was added:
+ ----- Method: SameGameBoard>>tileAt: (in category 'accessing') -----
+ tileAt: aPoint
+ 
+ 	^ submorphs at: (aPoint x + (aPoint y * columns) + 1)!

Item was added:
+ ----- Method: SameGameBoard>>tileClickedAt:newSelection: (in category 'actions') -----
+ tileClickedAt: location newSelection: isNewSelection 
+ 	| tile |
+ 	isNewSelection 
+ 		ifTrue: 
+ 			[self deselectSelection.
+ 			tile := self tileAt: location.
+ 			selectionColor := tile color.
+ 			selection := OrderedCollection with: location.
+ 			self selectTilesAdjacentTo: location.
+ 			selection size = 1 
+ 				ifTrue: [self deselectSelection]
+ 				ifFalse: 
+ 					[(target notNil and: [actionSelector notNil]) 
+ 						ifTrue: [target perform: actionSelector withArguments: arguments]]]
+ 		ifFalse: [self removeSelection]!

Item was added:
+ ----- Method: SameGameBoard>>tilesRemaining (in category 'private') -----
+ tilesRemaining
+ 
+ 	^ (submorphs reject: [:m | m disabled]) size
+ !

Item was added:
+ ----- Method: SameGameBoard>>undoFromCapturedState: (in category 'undo') -----
+ undoFromCapturedState: st 
+ 
+ 	self copyFrom: st first.
+ 	st second do: [:assn | (submorphs at: assn key) copyFrom: assn value].
+ 	selection ifNotNil:
+ 		[selection do: [:loc | (self tileAt: loc) setSwitchState: false; color: selectionColor].
+ 		selection _ nil].
+ 	owner scoreDisplay flash: st third.  "score display"
+ 	owner scoreDisplay value: st fourth.
+ 	self changed.!

Item was added:
+ SimpleSwitchMorph subclass: #SameGameTile
+ 	instanceVariableNames: 'switchState disabled oldSwitchState'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!
+ 
+ !SameGameTile commentStamp: '<historical>' prior: 0!
+ I am a single tile for the SameGame.  I act much like a switch.!

Item was added:
+ ----- Method: SameGameTile class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 
+ 	^false!

Item was added:
+ ----- Method: SameGameTile>>color: (in category 'accessing') -----
+ color: aColor 
+ 	super color: aColor.
+ 	onColor _ aColor.
+ 	offColor _ aColor.
+ 	self changed!

Item was added:
+ ----- Method: SameGameTile>>disabled (in category 'accessing') -----
+ disabled
+ 
+ 	^ disabled!

Item was added:
+ ----- Method: SameGameTile>>disabled: (in category 'accessing') -----
+ disabled: aBoolean
+ 
+ 	disabled _ aBoolean.
+ 	disabled
+ 		ifTrue:
+ 			[self color: owner color.
+ 			self borderColor: owner color]
+ 		ifFalse:
+ 			[self setSwitchState: self switchState]!

Item was added:
+ ----- Method: SameGameTile>>doButtonAction (in category 'button') -----
+ doButtonAction
+ 	"Perform the action of this button. The last argument of the message sent to the target is the new state of this switch."
+ 
+ 	(target notNil and: [actionSelector notNil]) 
+ 		ifTrue: 
+ 			[target perform: actionSelector
+ 				withArguments: (arguments copyWith: switchState)]!

Item was added:
+ ----- Method: SameGameTile>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	super initialize.
+ 	self label: ''.
+ 	self borderWidth: 2.
+ 	bounds _ 0 at 0 corner: 16 at 16.
+ 	offColor _ Color gray.
+ 	onColor _ Color gray.
+ 	switchState _ false.
+ 	oldSwitchState _ false.
+ 	disabled _ false.
+ 	self useSquareCorners
+ 	!

Item was added:
+ ----- Method: SameGameTile>>insetColor (in category 'accessing') -----
+ insetColor
+ 	"Use my own color for insets"
+ 	^color!

Item was added:
+ ----- Method: SameGameTile>>mouseDown: (in category 'event handling') -----
+ mouseDown: evt
+ 
+ 	disabled ifFalse:
+ 		[oldSwitchState _ switchState.
+ 		self setSwitchState: (oldSwitchState = false).
+ 		self doButtonAction].
+ !

Item was added:
+ ----- Method: SameGameTile>>mouseMove: (in category 'event handling') -----
+ mouseMove: evt
+ 
+ 	"don't do anything, here"!

Item was added:
+ ----- Method: SameGameTile>>mouseUp: (in category 'event handling') -----
+ mouseUp: evt
+ 
+ 	"don't do anything, here"!

Item was added:
+ ----- Method: SameGameTile>>setSwitchState: (in category 'accessing') -----
+ setSwitchState: aBoolean
+ 
+ 	switchState _ aBoolean.
+ 	disabled ifFalse:
+ 		[switchState
+ 			ifTrue:
+ 				[self borderColor: #inset.
+ 				self color: onColor]
+ 			ifFalse:
+ 				[self borderColor: #raised.
+ 				self color: offColor]]!

Item was added:
+ ----- Method: SameGameTile>>switchState (in category 'accessing') -----
+ switchState
+ 
+ 	^ switchState!

Item was added:
+ ----- Method: SampledSound class>>addLibrarySoundNamed:bytes:codecSignature: (in category '*Etoys-Squeakland-sound library') -----
+ addLibrarySoundNamed: aString bytes: aByteArray codecSignature: signature
+ 	SoundLibrary
+ 		at: aString
+ 		put: (Array with: aByteArray with: signature).
+ !

Item was added:
+ ----- Method: SampledSound class>>renameSound:newName: (in category '*Etoys-Squeakland-sound library') -----
+ renameSound: aString newName: newName
+ 	"Rename the sound currently known by the first arg to be now known by the second arg."
+ 
+ 	SoundLibrary at: newName put: (SoundLibrary at: aString).
+ 	SoundLibrary removeKey: aString!

Item was added:
+ SymbolListType subclass: #SamplingRate
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-MorphicExtras-Widgets'!

Item was added:
+ ----- Method: SamplingRate>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 	"Vocabulary initialize"
+ 	super initialize.
+ 	self vocabularyName: #SamplingRate.
+ 	symbols := #('11025' '22050' '44100')
+ 	
+ !

Item was added:
+ ----- Method: SamplingRate>>representsAType (in category 'as yet unclassified') -----
+ representsAType
+ 	^true!

Item was added:
+ ----- Method: Scanner>>initScanner (in category '*Etoys-Squeakland-initialize-release') -----
+ initScanner
+ 
+ 	buffer _ WriteStream on: (String new: 40).
+ 	typeTable _ TypeTable!

Item was added:
+ ----- Method: Scanner>>nextLiteral (in category '*Etoys-Squeakland-expression types') -----
+ nextLiteral
+ 	"Same as advance, but -4 comes back as a number instead of two tokens"
+ 
+ 	| prevToken |
+ 	prevToken _ self advance.
+ 	(prevToken == #- and: [token isKindOf: Number])
+ 		ifTrue: 
+ 			[^self advance negated].
+ 	^prevToken!

Item was added:
+ ----- Method: ScorePlayerMorph class>>playMidiStream: (in category '*Etoys-Squeakland-class initialization') -----
+ playMidiStream: aStream
+ 	"Read a MIDI file stream.  Does nothing if called with nil name."
+  
+ 	| f score |
+ 
+ 	Smalltalk at: #MIDIFileReader ifPresent: [:midiReader |
+ 			f _ aStream binary.
+ 			score _ (midiReader new readMIDIFrom: f) asScore.
+ 			f close.
+ 			self openOn: score title: aStream name]
+ !

Item was added:
+ ----- Method: ScorePlayerMorph>>buttonName:action: (in category '*Etoys-Squeakland-layout') -----
+ buttonName: aString action: aSymbol
+ 	"Create a button with the given label and action selector, and answer it."
+ 
+ 	^ SimpleButtonMorph new
+ 		target: self;
+ 		label: aString font: ScriptingSystem fontForEToyButtons;
+ 		actionSelector: aSymbol!

Item was added:
+ Object subclass: #ScratchPlugin
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'TestFileName'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Scratch'!
+ 
+ !ScratchPlugin commentStamp: '<historical>' prior: 0!
+ Copyright (c) 2008 Massachusetts Institute of Technology
+ The ScratchPlugin is reused with permission from the ScratchCode1.3.1 release.
+ Thanks to Mitchel Resnick, John Maloney, and the other Lifelong Kindergardeners!! 
+ ----------------------------------------------------------------------------------------------------
+ 
+ This plugin combines a number of primitives needed by Scratch including:
+ 
+   a. primitives that manipulate 24-bit color images (i.e. 32-bit deep Forms but alpha is ignored)
+   b. primitive to open browsers, find the user's documents folder, set the window title and other host OS functions
+ 
+ This plugin includes new serial port primitives, including support for named serial ports. The underlying plugin code can support up to 32 simultaenously open ports.
+ 
+ Port options for Set/GetOption primitives:
+   1. baud rate
+   2. data bits
+   3. stop bits
+   4. parity type
+   5. input flow control type
+   6. output flow control type
+ 
+ Handshake lines (options 20-25 for Set/GetOption primitives):
+   20. DTR	(output line)
+   21. RTS	(output line)
+   22. CTS	(input line)
+   23. DSR	(input line)
+   24. CD		(input line)
+   25. RI		(input line)
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>blurTest: (in category 'image filters-testing') -----
+ blurTest: count
+ 	"self blurTest: 10"
+ 
+ 	| f outBits |
+ 	f _ (Form fromFileNamed: TestFileName) asFormOfDepth: 32.
+ 	f display.
+ 	count timesRepeat: [
+ 		outBits _ f bits copy.
+ 		self primBlur: f bits into: outBits width: f width.
+ 		f bits: outBits.
+ 		f display].
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>brightnessShiftTest (in category 'image filters-testing') -----
+ brightnessShiftTest
+ 	"self brightnessShiftTest"
+ 
+ 	| f fOut shift |
+ 	f _ (Form fromFileNamed: TestFileName) asFormOfDepth: 32.
+ 	fOut _ f deepCopy.
+ 	[Sensor anyButtonPressed] whileFalse: [
+ 		shift _ ((Sensor cursorPoint x - Display center x) * 220) // Display width.
+ 		self primShiftBrightness: f bits into: fOut bits by: shift.
+ 		fOut display].
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>closePort: (in category 'serial port primitives') -----
+ closePort: portNum
+ 	"Close the given port."
+ 	"self closePort: 1"
+ 
+ 	<primitive: 'primClose' module: 'ScratchPlugin'>
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>compactSound:by: (in category 'sound buffer utilities') -----
+ compactSound: aSoundBuffer by: log2
+ 	"Collapse the given by cutting in half log2 times."
+ 	"self compactSound: (SoundBuffer fromArray: (1 to: 100) asArray) by: 3"
+ 
+ 	| buf |
+ 	buf _ aSoundBuffer.
+ 	log2 timesRepeat: [buf _ self extractChannelFrom: buf rightFlag: false].
+ 	^ buf
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>condenseSoundBuffer:by: (in category 'sound buffer utilities') -----
+ condenseSoundBuffer: aSoundBuffer by: factor
+ 	"Condense the given SoundBuffer by the given factor. The result is a SoundBuffer 1/factor of the original size in which each sample represents the peak signal value over factor samples of the source."
+ 	"self condenseSoundBuffer: (SoundBuffer fromArray: (1 to: 100) asArray) by: 10"
+ 
+ 	| result |
+ 	result _ SoundBuffer newMonoSampleCount: (aSoundBuffer size + factor - 1) // factor.
+ 	self primCondense: aSoundBuffer into: result by: factor.
+ 	^ result
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>declareCVarsIn: (in category 'translation') -----
+ declareCVarsIn: aCCodeGenerator
+ 	"self translate"
+ 
+ 	super declareCVarsIn: aCCodeGenerator.
+ 	aCCodeGenerator cExtras: '
+ #include "scratchOps.h"
+ #include <math.h>
+ '.!

Item was added:
+ ----- Method: ScratchPlugin class>>doubleTest (in category 'image filters-testing') -----
+ doubleTest
+ 	"self doubleTest"
+ 
+ 	| f fOut |
+ 	f _ (Form fromFileNamed: TestFileName) asFormOfDepth: 32.
+ 	fOut _ Form extent: (2 * f extent) + 20 depth: 32.
+ 	self primDouble: f bits w: f width h: f height into: fOut bits w: fOut width h: fOut height x: 9 y: 10.
+ 	fOut display.
+ 
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>extractChannelFrom:rightFlag: (in category 'sound buffer utilities') -----
+ extractChannelFrom: aSoundBuffer rightFlag: rightFlag
+ 	"Extract one channel from the given stereo sound buffer. If rightFlag is true, extract the right channel; otherwise, extract the left one."
+ 	"self extractChannelFrom: (SoundBuffer fromArray: #(1 2 3 4)) rightFlag: true"
+ 
+ 	| result |
+ 	result _ SoundBuffer newMonoSampleCount: aSoundBuffer size // 2.
+ 	self primExtractChannelFrom: aSoundBuffer into: result rightFlag: rightFlag.
+ 	^ result
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>fishEye:out:power: (in category 'image filters-testing') -----
+ fishEye: inForm out: outForm power: power
+ 
+ 	| height sz centerX centerY dx dy ang pix  width r srcX srcY |
+ 	"calculate height, center, scales, radius, whirlRadians, and radiusSquared"
+ 	sz _ inForm bits size.
+ 	width _ inForm width.
+ 
+ 	height _ sz // width.
+ 	centerX _ width // 2.
+ 	centerY _ height // 2.
+ 
+ 	0 to: width - 1 do: [:x |
+ 		0 to: height - 1 do: [:y |
+ 			dx _ (x - centerX) / centerX asFloat.
+ 			dy _ (y - centerY) / centerY asFloat.
+ 			r _ ((dx * dx) + (dy * dy)) sqrt raisedTo: power.
+ 			r <= 1.0
+ 				ifTrue: [
+ 					ang _ dy arcTan: dx.
+ 					srcX _ centerX + ((r * ang cos) * centerX).
+ 					srcY _ centerY + ((r * ang sin) * centerY)]
+ 				ifFalse: [
+ 					srcX _ x.
+ 					srcY _ y].
+ 			pix _ self primInterpolate: inForm bits width: inForm width x: (srcX * 1024) truncated y: (srcY * 1024) truncated.
+ 			outForm bits at: ((y * width) + x + 1) put: pix]].
+ 
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>fisheyeTest (in category 'image filters-testing') -----
+ fisheyeTest
+ 	"self fisheyeTest"
+ 
+ 	| f fOut |
+ 	f _ (Form fromFileNamed: TestFileName) asFormOfDepth: 32.
+ 	fOut _ f deepCopy.
+ 	f display.
+ 	100 to: 300 by: 10 do: [:power |
+ 		self primFisheye: f bits into: fOut bits width: f width power: power.
+ 		fOut display].
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>fisheyeTest2: (in category 'image filters-testing') -----
+ fisheyeTest2: power
+ 	"self fisheyeTest2: 100"
+ 
+ 	| f fOut |
+ 	f _ (Form fromFileNamed: TestFileName) asFormOfDepth: 32.
+ 	fOut _ f deepCopy.
+ 	f display.
+ 	self primFisheye: f bits into: fOut bits width: f width power: power.
+ 	fOut display.
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>hasHeaderFile (in category 'translation') -----
+ hasHeaderFile
+ 
+ 	^true!

Item was added:
+ ----- Method: ScratchPlugin class>>hueShiftTest (in category 'image filters-testing') -----
+ hueShiftTest
+ 	"self hueShiftTest"
+ 
+ 	| f fOut shift |
+ 	f _ (Form fromFileNamed: TestFileName) asFormOfDepth: 32.
+ 	fOut _ f deepCopy.
+ 	[Sensor anyButtonPressed] whileFalse: [
+ 		shift _ ((Sensor cursorPoint x - Display center x) * 380 * 2) // Display width.
+ 		self primShiftHue: f bits into: fOut bits byDegrees: shift.
+ 		fOut display].
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>interpolationTest: (in category 'image filters-testing') -----
+ interpolationTest: scale
+ 	"Answer a copy of the given form scaled by the given factor using linear interpolation."
+ 	"(self interpolationTest: 1.5) display"
+ 
+ 	| scaleP srcForm outExtent fOut w h outW pix outH |
+ 	scaleP _ scale asPoint.
+ 	(scaleP x <= 0 or: [scaleP y <= 0]) ifTrue: [self error: 'bad scale factor'].
+ 	srcForm _ (Form fromFileNamed: TestFileName) asFormOfDepth: 32.
+ 	outExtent _ (srcForm extent * scaleP) truncated.
+ 	(outExtent x > 1000 or: [outExtent y > 1000]) ifTrue: [self halt: 'result width or height will be > 1000 pixels'].
+ 	fOut _ Form extent: outExtent depth: 32.
+ 	w _ srcForm width.
+ 	h _ srcForm height.
+ 	outW _ fOut width.
+ 	outH _ fOut height.
+ 	0 to: fOut width - 1 do: [:x |
+ 		0 to: fOut height - 1 do: [:y |
+ 			pix _ self
+ 				primInterpolate: srcForm bits
+ 				width: srcForm width
+ 				x: (x * w * 1024) // outW
+ 				y:  (y * h * 1024) // outH.
+ 			fOut bits at: ((y * outW) + x + 1) put: pix]].
+ 	^ fOut
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>isHidden: (in category 'OS utilities') -----
+ isHidden: fullPath
+ 	"Return true if file or folder with the given path should be hidden from the user. Return false if the primitive fails."
+ 	"self isHidden: 'testfile.txt'"
+ 
+ 	Smalltalk isMacOSX ifTrue: [^ false].
+ 	((fullPath endsWith: ':\') and: [fullPath size = 3]) ifTrue: [^ false].
+ 
+ 	^ self primIsHidden: fullPath
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>isPortOpen: (in category 'serial port primitives') -----
+ isPortOpen: portNum
+ 	"Answer true if the given serial port is open."
+ 	"self isPortOpen: 1"
+ 
+ 	<primitive: 'primIsPortOpen' module: 'ScratchPlugin'>
+ 	^ false
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>openPortNamed:baud: (in category 'serial port primitives') -----
+ openPortNamed: portName baud: baudRate
+ 	"Open the port with the given name at the given baud rate. Answer the port number to use for further operations on the given port or -1 if the port could not be opened."
+ 	"self openPortNamed: '/dev/cu.USA19QW3b1P1.1' baud: 9600"
+ 
+ 	<primitive: 'primOpenPortNamed' module: 'ScratchPlugin'>
+ 	^ -1
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>pluginAvailable (in category 'OS utilities') -----
+ pluginAvailable
+ 	"self pluginAvailable"
+ 
+ 	| f r |
+ 	f _ Form extent: 1 at 1 depth: 32.
+ 	[r _ self primShiftHue: f bits into: f bits byDegrees: 180] ifError: [^ false].
+ 	^ r notNil
+ 
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>port:getOption: (in category 'serial port primitives') -----
+ port: portNum getOption: optionNum
+ 	"Answer the value of the given serial port option, or nil if the port is not open or the option is not defined. See the class comment for the list of options."
+ 
+ 	<primitive: 'primGetOption' module: 'ScratchPlugin'>
+ 	^ nil
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>port:setOption:to: (in category 'serial port primitives') -----
+ port: portNum setOption: optionNum to: anInteger
+ 	"Set the given serial port option to the given value. Do nothing if the option is not defined. See the class comment for the list of options."
+ 
+ 	<primitive: 'primSetOption' module: 'ScratchPlugin'>
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>portCount (in category 'serial port primitives') -----
+ portCount
+ 	"Answer the number of serial ports. Answer 0 if there are no ports or if this primitive fails."
+ 	"self portCount"
+ 
+ 	<primitive: 'primPortCount' module: 'ScratchPlugin'>
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>portCountOrNil (in category 'serial port primitives') -----
+ portCountOrNil
+ 	"Answer the number of serial ports. Answer nil if this primitive fails."
+ 	"self portCountOrNil"
+ 
+ 	<primitive: 'primPortCount' module: 'ScratchPlugin'>
+ 	^ nil
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>portName: (in category 'serial port primitives') -----
+ portName: portIndex
+ 	"Answer the name of the serial port with the given index. Answer nil if there is no port with the given index."
+ 	"self portName: 1"
+ 
+ 	<primitive: 'primPortName' module: 'ScratchPlugin'>
+ 	^ nil
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primBlur:into:width: (in category 'image filter primitives') -----
+ primBlur: inBitmap into: outBitmap width: w
+ 	"Blur all the non-transparent pixels in the given 32-bit image bitmap, storing the result in outBitmap. The two bitmaps must be the same size. Each call to this primitive does one Gausian blur step."
+ 
+ 	<primitive: 'primitiveBlur' module: 'ScratchPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primCondense:into:by: (in category 'sound buffer utilities') -----
+ primCondense: srcSoundBuffer into: dstSoundBuffer by: anInteger
+ 	"Condense the given SoundBuffer by the given factor storing the rsult into the destination SoundBuffer."
+ 
+ 	<primitive: 'primitiveCondenseSound' module: 'ScratchPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primDouble:w:h:into:w:h:x:y: (in category 'image filter primitives') -----
+ primDouble: srcBitmap w: srcWidth h: srcHeight into: dstBitmap w: dstWidth h: dstHeight x: dstX y: dstY
+ 	"Display the source form at double-size onto the destination form at the given location. Fails if the target rectangle does not fit entirely within the destination form."
+ 
+ 	<primitive: 'primitiveDoubleSize' module: 'ScratchPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primExtractChannelFrom:into:rightFlag: (in category 'sound buffer utilities') -----
+ primExtractChannelFrom: srcSoundBuffer into: dstSoundBuffer rightFlag: rightFlag
+ 	"Extract the given channel of the source SoundBuffer in the destination SoundBuffer."
+ 
+ 	<primitive: 'primitiveExtractChannel' module: 'ScratchPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primFisheye:into:width:power: (in category 'image filter primitives') -----
+ primFisheye: inBitmap into: outBitmap width: w power: anInteger
+ 	"Do a fisheye lens transform of the given 32-bit image bitmap by the given power, storing the result in outBitmap. The two bitmaps must be the same size. Power is 0 for no change, > 0 for fisheye, < 0 for black hole effect."
+ 
+ 	<primitive: 'primitiveFisheye' module: 'ScratchPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primGetFolderPath: (in category 'OS utilities') -----
+ primGetFolderPath: anInteger
+ 	"Return the folder path for the given ID. Folder ID's are:
+ 		1	home
+ 		2	desktop
+ 		3	documents
+ 		4	my pictures
+ 		5	my music.
+ 	Return the path for the Scratch folder if the primitive fails."
+ 	"self primGetFolderPath: 1"
+ 
+ 	<primitive: 'primitiveGetFolderPath' module: 'ScratchPlugin'>
+ 	^ FileDirectory default pathName
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primInterpolate:width:x:y: (in category 'image filter primitives') -----
+ primInterpolate: aBitmap width: w x: xFixed y: yFixed
+ 	"Answer the interpolated pixel value from the given 32-bit bitmap with the given width. The coordinates are given as fixed-point integers with 10-bits of fraction. That is, the float values of x and y are multiplied by 1024, then truncated."
+ 
+ 	<primitive: 'primitiveInterpolate' module: 'ScratchPlugin'>
+ 	^ 0!

Item was added:
+ ----- Method: ScratchPlugin class>>primIsHidden: (in category 'OS utilities') -----
+ primIsHidden: fullPath
+ 	"Return true if file or folder with the given path should be hidden from the user. Return false if the primitive fails."
+ 	"self primIsHidden: 'testfile.txt'"
+ 
+ 	<primitive: 'primitiveIsHidden' module: 'ScratchPlugin'>
+ 	^ false
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primOpenURL: (in category 'OS utilities') -----
+ primOpenURL: aString
+ 	"Open a browser window on the given URL. Do nothing if the primitive fails."
+ 	"self primOpenURL: 'http://www.google.com'"
+ 
+ 	<primitive: 'primitiveOpenURL' module: 'ScratchPlugin'>
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primScale:w:h:into:w:h: (in category 'image filter primitives') -----
+ primScale: srcBitmap w: srcWidth h: srcHeight into: dstBitmap w: dstWidth h: dstHeight
+ 	"Scale the source form to exactly fit the destination form using bilinear interpolation."
+ 
+ 	<primitive: 'primitiveScale' module: 'ScratchPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primScaleNoFail:w:h:into:w:h: (in category 'image filter primitives') -----
+ primScaleNoFail: srcBitmap w: srcWidth h: srcHeight into: dstBitmap w: dstWidth h: dstHeight
+ 	"Scale the source form to exactly fit the destination form using bilinear interpolation. Answer nil if I fail."
+ 
+ 	<primitive: 'primitiveScale' module: 'ScratchPlugin'>
+ 	^ nil
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primSetUnicodePasteBuffer: (in category 'OS utilities') -----
+ primSetUnicodePasteBuffer: aByteArray
+ 	"Set the Mac OS X Unicode paste buffer. The argument is a big-endian UTF-16 Unicode string packed into a ByteArray. Needed to paste strings from Squeak into Second Life's code editor under Mac OS X. Do nothing if the primitive fails."
+ 	"self primSetUnicodePasteBuffer: ByteArray new"
+ 
+ 	<primitive: 'primitiveSetUnicodePasteBuffer' module: 'ScratchPlugin'>
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primSetWindowTitle: (in category 'OS utilities') -----
+ primSetWindowTitle: aString
+ 	"Set the title of the Scratch window to the given string. Do nothing if the primitive fails."
+ 	"self primSetWindowTitle: 'hello!!'"
+ 
+ 	<primitive: 'primitiveSetWindowTitle' module: 'ScratchPlugin'>
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primShiftBrightness:into:by: (in category 'image filter primitives') -----
+ primShiftBrightness: inBitmap into: outBitmap by: shift
+ 	"Shift the brightness of all the non-transparent pixels in the given 32-bit image bitmap, storing the result in outBitmap. The shift should be an integer between -100 and 100. The two bitmaps must be the same size."
+ 
+ 	<primitive: 'primitiveBrightnessShift' module: 'ScratchPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primShiftHue:into:byDegrees: (in category 'image filter primitives') -----
+ primShiftHue: inBitmap into: outBitmap byDegrees: shiftDegrees
+ 	"Shift the hue of all the non-transparent, non-black pixels in the given 32-bit image bitmap, storing the result in outBitmap. The shift should be an integer between -360 and 360. The two bitmaps must be the same size."
+ 
+ 	<primitive: 'primitiveHueShift' module: 'ScratchPlugin'>
+ 	self primitiveFailed.
+ 	^ nil
+ 
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primShiftSaturation:into:by: (in category 'image filter primitives') -----
+ primShiftSaturation: inBitmap into: outBitmap by: shift
+ 	"Shift the saturation of all the non-transparent, non-black pixels in the given 32-bit image bitmap, storing the result in outBitmap. The shift should be an integer between -100 and 100. The two bitmaps must be the same size."
+ 
+ 	<primitive: 'primitiveSaturationShift' module: 'ScratchPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primShortToLongPath: (in category 'OS utilities') -----
+ primShortToLongPath: aString
+ 	"Convert the given Windows short-filename path into a long-filename path. On other platforms this primitive will just return the input string."
+ 	"self primShortToLongPath: 'hello!!'"
+ 
+ 	<primitive: 'primitiveShortToLongPath' module: 'ScratchPlugin'>
+ 	^ aString
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primWaterRipples1:into:width:dropNum:array1:array2: (in category 'image filter primitives') -----
+ primWaterRipples1: inBitmap into: outBitmap width: w dropNum: aNum array1: aArray array2: bArray
+ 	"Apply the water ripple effect to inBitmap putting the result into outBitmap. The two bitmaps must have the same length and are for 32-bit deep Forms of the given width. The dropNum determines how many new water drops are started. The two arrays hold the state of the water-surface model."
+ 
+ 	<primitive: 'primitiveWaterRipples1' module: 'ScratchPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primWhirl:into:width:angle: (in category 'image filter primitives') -----
+ primWhirl: inBitmap into: outBitmap width: w angle: anAngle
+ 	"Whirl all the non-transparent pixels in the given 32-bit image bitmap by the given angle, storing the result in outBitmap. The two bitmaps must be the same size."
+ 
+ 	<primitive: 'primitiveWhirl' module: 'ScratchPlugin'>
+ 	self primitiveFailed
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>primitiveFailed (in category 'primitive failure') -----
+ primitiveFailed
+ 	"Just beep rather than bringing up an error notifier."
+ 
+ 	self beep.
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>readPort:into: (in category 'serial port primitives') -----
+ readPort: portNum into: buffer
+ 	"Read from the given port into the given ByteArray or String and answer the number of bytes read."
+ 	"self readPort: 1 into: (ByteArray new: 10)"
+ 
+ 	<primitive: 'primRead' module: 'ScratchPlugin'>
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>saturationShiftTest (in category 'image filters-testing') -----
+ saturationShiftTest
+ 	"self saturationShiftTest"
+ 
+ 	| f fOut shift |
+ 	f _ (Form fromFileNamed: TestFileName) asFormOfDepth: 32.
+ 	fOut _ f deepCopy.
+ 	[Sensor anyButtonPressed] whileFalse: [
+ 		shift _ ((Sensor cursorPoint x - Display center x) * 220) // Display width.
+ 		self primShiftSaturation: f bits into: fOut bits by: shift.
+ 		fOut display].
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>scale:by: (in category 'OS utilities') -----
+ scale: aForm by: scale
+ 	"Answer a 32-bit deep Form that's aForm scaled by the given factor. Scales using linear interpolation."
+ 
+ 	| srcF scaledF r |
+ 	srcF _ aForm asFormOfDepth: 32.
+ 	srcF unhibernate.
+ 	scaledF _ Form extent: (srcF extent * scale) rounded depth: 32.
+ 	r _ self
+ 		primScaleNoFail: srcF bits w: srcF width h: srcF height
+ 		into: scaledF bits w: scaledF width h: scaledF height.
+ 	r ifNil: [^ srcF magnify: srcF boundingBox by: scale asFloat smoothing: 1].
+ 	^ scaledF
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>scaleTest: (in category 'image filters-testing') -----
+ scaleTest: scale
+ 	"self scaleTest: 1.5"
+ 
+ 	| f fOut |
+ 	f _ (Form fromFileNamed: TestFileName) asFormOfDepth: 32.
+ 	fOut _ Form extent: (f extent * scale) rounded depth: 32.
+ 	self primScale: f bits w: f width h: f height into: fOut bits w: fOut width h: fOut height.
+ 	fOut display.
+ 
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>serialPortOpsAvailable (in category 'serial port primitives') -----
+ serialPortOpsAvailable
+ 	"Answer true if this plugin is available."
+ 	"self serialPortOpsAvailable"
+ 	"Smalltalk unloadPlugin: self name"
+ 
+ 	^ self portCountOrNil notNil
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>setUnicodePasteBuffer: (in category 'OS utilities') -----
+ setUnicodePasteBuffer: aString
+ 	"Set the Mac OS X Unicode paste buffer to the given Squeak string. Since the source is a Squeak string, there is no need to handle UTF-16 extended (4-byte) characters. However, we must take byte order into account to accomodate both Intel and PowerPC."
+ 	"self setUnicodePasteBuffer: 'Hello, Unicode!!'"
+ 
+ 	| utf32 s |
+ 	utf32 _ aString asUTF32.
+ 	s _ WriteStream on: (ByteArray new: 2 * aString size).
+ 	Smalltalk isBigEndian
+ 		ifTrue: [utf32 do: [:u | s nextPut: (u >> 8). s nextPut: (u bitAnd: 255)]]
+ 		ifFalse: [utf32 do: [:u | s nextPut: (u bitAnd: 255). s nextPut: (u >> 8)]].
+ 
+ 	self primSetUnicodePasteBuffer: s contents.
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>testFileName: (in category 'image filters-testing') -----
+ testFileName: aString
+ 	"Set the name of an image file for testing."
+ 	"self testFileName: 'hammy.jpg'"
+ 	"self testFileName: 'JohnMugShotBW.jpg'"
+ 
+ 	TestFileName _ aString.
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>waterRipples1ModuleTest (in category 'image filters-testing') -----
+ waterRipples1ModuleTest
+ 	"Smalltalk unloadPlugin: self name"
+ 	"self waterRipples1ModuleTest"
+ 
+ 	| f fOut ripply aArray bArray |
+ 	f _ (Form fromFileNamed: TestFileName) asFormOfDepth: 32.
+ 	fOut _ f deepCopy.
+ 	aArray _ ByteArray new: (f width) * (f height) * 8 withAll: 0.
+ 	bArray _ ByteArray new: (f width) * (f height) * 8 withAll: 0.
+ 
+ 	[Sensor anyButtonPressed] whileFalse: [
+ 		ripply _ Sensor cursorPoint x max: 1.
+ 		ripply _ (((ripply / fOut width) sqrt) * 16.0) asInteger.
+ 		ripply < 1 ifTrue: [ripply _ 1].
+ ripply printString display.
+ 		self primWaterRipples1: f bits
+ 			into: fOut bits
+ 			width: f width
+ 			dropNum: ripply
+ 			array1: aArray
+ 			array2: bArray.
+ 		fOut displayAt: 10 at 30].
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>waterRipples1ModuleTest: (in category 'image filters-testing') -----
+ waterRipples1ModuleTest: n
+ 	"Smalltalk unloadPlugin: self name"
+ 	"self waterRipples1ModuleTest: 100"
+ 
+ 	| f fOut aArray bArray |
+ 	f _ (Form fromFileNamed: TestFileName) asFormOfDepth: 32.
+ 	fOut _ f deepCopy.
+ 	aArray _ ByteArray new: (f width * f height) * 8 withAll: 0.
+ 	bArray _ ByteArray new: (f width * f height) * 8 withAll: 0.
+ 
+ 	self primWaterRipples1: f bits
+ 		into: fOut bits
+ 		width: f width
+ 		dropNum: n
+ 		array1: aArray
+ 		array2: bArray.
+ 	[Sensor anyButtonPressed] whileFalse: [
+ 		self primWaterRipples1: f bits
+ 			into: fOut bits
+ 			width: f width
+ 			dropNum: 1
+ 			array1: aArray
+ 			array2: bArray.
+ 		fOut displayAt: 10 at 30].
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>waterRipplesTime: (in category 'image filters-testing') -----
+ waterRipplesTime: n
+ 	"Smalltalk unloadPlugin: self name"
+ 	"self waterRipplesTime: 100"
+ 
+ 	| f fOut aArray bArray |
+ 	f _ (Form fromFileNamed: TestFileName) asFormOfDepth: 32.
+ 	fOut _ f deepCopy.
+ 	aArray _ ByteArray new: (f width * f height) * 8 withAll: 0.
+ 	bArray _ ByteArray new: (f width * f height) * 8 withAll: 0.
+ 
+ 	self primWaterRipples1: f bits
+ 		into: fOut bits
+ 		width: f width
+ 		dropNum: n
+ 		array1: aArray
+ 		array2: bArray.
+ 
+ 	^ [100 timesRepeat: [
+ 		self primWaterRipples1: f bits
+ 			into: fOut bits
+ 			width: f width
+ 			dropNum: 100
+ 			array1: aArray
+ 			array2: bArray]] msecs.
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>whirlTest (in category 'image filters-testing') -----
+ whirlTest
+ 	"self whirlTest"
+ 
+ 	| f fOut degrees |
+ 	f _ (Form fromFileNamed: TestFileName) asFormOfDepth: 32.
+ 	fOut _ f deepCopy.
+ 	[Sensor anyButtonPressed] whileFalse: [
+ 		degrees _ ((Sensor cursorPoint x - Display center x) * 450 * 2) // Display width.
+ 		self primWhirl: f bits into: fOut bits width: f width angle: degrees.
+ 		fOut display].
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>writePort:data: (in category 'serial port primitives') -----
+ writePort: portNum data: buffer
+ 	"Write data from the given ByteArray or String to the given port and answer the number of bytes written."
+ 	"self writePort: 1 into: (ByteArray new: 10)"
+ 
+ 	<primitive: 'primWrite' module: 'ScratchPlugin'>
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>bitmap:at:putH:s:v: (in category 'private') -----
+ bitmap: bitmap at: i putH: hue s: saturation v: brightness
+ 
+ 	| hI hF p q t v outPix |
+ 	<inline: true>
+ 	<var: 'bitmap' declareC: 'unsigned int *bitmap'>
+ 
+ 	hI := hue // 60.  "integer part of hue (0..5)"
+ 	hF := hue \\ 60.  "fractional part ofhue"
+ 	p := (1000 - saturation) * brightness.
+ 	q := (1000 - ((saturation * hF) // 60)) * brightness.
+ 	t := (1000 - ((saturation * (60 - hF)) // 60)) * brightness.
+ 
+ 	v := (brightness * 1000) // 3922.
+ 	p := p // 3922.
+ 	q := q // 3922.
+ 	t := t // 3922.
+ 
+ 	0 = hI ifTrue: [outPix := ((v bitShift: 16) + (t bitShift: 8) + p)].
+ 	1 = hI ifTrue: [outPix := ((q bitShift: 16) + (v bitShift: 8) + p)].
+ 	2 = hI ifTrue: [outPix := ((p bitShift: 16) + (v bitShift: 8) + t)].
+ 	3 = hI ifTrue: [outPix := ((p bitShift: 16) + (q bitShift: 8) + v)].
+ 	4 = hI ifTrue: [outPix := ((t bitShift: 16) + (p bitShift: 8) + v)].
+ 	5 = hI ifTrue: [outPix := ((v bitShift: 16) + (p bitShift: 8) + q)].
+ 
+ 	outPix = 0 ifTrue: [outPix := 1].  "convert transparent to 1"
+ 	bitmap at: i put: outPix.
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>checkedFloatPtrOf: (in category 'private') -----
+ checkedFloatPtrOf: oop
+ 	"Return an unsigned int pointer to the first indexable word of oop, which must be a words object."
+ 
+ 	<inline: true>
+ 	<returnTypeC: 'double *'>
+ 
+ 	interpreterProxy success: (interpreterProxy isWordsOrBytes: oop).
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 	^ self cCoerce: (interpreterProxy firstIndexableField: oop) to: 'double *'
+ !

Item was added:
+ ----- Method: ScratchPlugin>>checkedUnsignedIntPtrOf: (in category 'private') -----
+ checkedUnsignedIntPtrOf: oop
+ 	"Return an unsigned int pointer to the first indexable word of oop, which must be a words object."
+ 
+ 	<inline: true>
+ 	<returnTypeC: 'unsigned int *'>
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: oop).
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 	^ self cCoerce: (interpreterProxy firstIndexableField: oop) to: 'unsigned int *'
+ !

Item was added:
+ ----- Method: ScratchPlugin>>hueFromR:G:B:min:max: (in category 'private') -----
+ hueFromR: r G: g B: b min: min max: max
+ 	"Answer the hue, an angle between 0 and 360."
+ 
+ 	| span result |
+ 	<inline: true>
+ 
+ 	span := max - min.
+ 	span = 0 ifTrue: [^ 0].
+ 
+ 	r = max
+ 		ifTrue: [result := ((60 * (g - b)) // span)]
+ 		ifFalse: [
+ 			g = max
+ 				ifTrue: [result := 120 + ((60 * (b - r)) // span)]
+ 				ifFalse: [result := 240 + ((60 * (r - g)) // span)]].
+ 
+ 	result < 0 ifTrue: [^ result + 360].
+ 	^ result
+ !

Item was added:
+ ----- Method: ScratchPlugin>>interpolate:and:frac: (in category 'private') -----
+ interpolate: pix1 and: pix2 frac: frac2
+ 	"Answer the interpolated pixel value between the given two pixel values. If either pixel is zero (transparent) answer the other pixel. If both pixels are  transparent, answer transparent. The fraction is between 0 and 1023, out of a total range of 1024."
+ 
+ 	| frac1 r g b result |
+ 	<inline: true>
+ 
+ 	pix1 = 0 ifTrue: [^ pix2].  "pix1 is transparent"
+ 	pix2 = 0 ifTrue: [^ pix1].  "pix2 is transparent"
+ 
+ 	frac1 := 1024 - frac2.
+ 	r := ((frac1 * ((pix1 bitShift: -16) bitAnd: 16rFF)) + (frac2 * ((pix2 bitShift: -16) bitAnd: 16rFF))) // 1024.
+ 	g := ((frac1 * ((pix1 bitShift: -8) bitAnd: 16rFF)) + (frac2 * ((pix2 bitShift: -8) bitAnd: 16rFF))) // 1024.
+ 	b := ((frac1 * (pix1 bitAnd: 16rFF)) + (frac2 * (pix2 bitAnd: 16rFF))) // 1024.
+ 	result := (r bitShift: 16) + (g bitShift: 8) + b.
+ 	result = 0 ifTrue: [result := 1].
+ 	^ result
+ !

Item was added:
+ ----- Method: ScratchPlugin>>interpolatedFrom:x:y:width:height: (in category 'private') -----
+ interpolatedFrom: bitmap x: xFixed y: yFixed width: w height: h
+ 	"Answer the interpolated pixel value from the given bitmap at the given point. The x and y coordinates are fixed-point integers with 10 bits of fraction (i.e. they were multiplied by 1024, then truncated). If the given point is right on an edge, answer the nearest edge pixel value. If it is entirely outside of the image, answer 0 (transparent)."
+ 
+ 	| x y xFrac yFrac index topPix bottomPix |
+ 	<inline: true>
+ 	<var: 'bitmap' declareC: 'unsigned int *bitmap'>
+ 
+ 	x := xFixed bitShift: -10.
+ 	(x < -1 or: [x >= w]) ifTrue: [^ 0].
+ 	y := yFixed bitShift: -10.
+ 	(y < -1 or: [y >= h]) ifTrue: [^ 0].
+ 
+ 	xFrac := xFixed bitAnd: 1023.
+ 	x = -1 ifTrue: [x := 0. xFrac := 0].  "left edge"
+ 	x = (w - 1) ifTrue: [xFrac := 0].  "right edge"
+ 
+ 	yFrac := yFixed bitAnd: 1023.
+ 	y = -1 ifTrue: [y := 0. yFrac := 0].  "top edge"
+ 	y = (h - 1) ifTrue: [yFrac := 0].  "bottom edge"
+ 
+ 	index := (y * w) + x "for squeak: + 1".
+ 	topPix := (bitmap at: index) bitAnd: 16rFFFFFF.
+ 	xFrac > 0 ifTrue: [
+ 		topPix := self interpolate: topPix and: ((bitmap at: index + 1) bitAnd: 16rFFFFFF) frac: xFrac].
+ 
+ 	yFrac = 0 ifTrue: [^ topPix].  "no y fraction, so just use value from top row"
+ 
+ 	index := ((y + 1) * w) + x "for squeak: + 1".
+ 	bottomPix := (bitmap at: index) bitAnd: 16rFFFFFF.
+ 	xFrac > 0 ifTrue: [
+ 		bottomPix := self interpolate: bottomPix and: ((bitmap at: index + 1) bitAnd: 16rFFFFFF) frac: xFrac].
+ 
+ 	^ self interpolate: topPix and: bottomPix frac: yFrac
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primClose (in category 'serial port') -----
+ primClose
+ 	"Close the given serial port."
+ 
+ 	| portNum |
+ 	<export: true>
+ 	portNum := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	self cCode: 'SerialPortClose(portNum)'.
+ 
+ 	interpreterProxy pop: 1.  "pop arg, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primGetOption (in category 'serial port') -----
+ primGetOption
+ 	"Return the given option value for the given serial port."
+ 
+ 	| portNum attrNum result |
+ 	<export: true>
+ 	portNum := interpreterProxy stackIntegerValue: 1.
+ 	attrNum := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	result := self cCode: 'SerialPortGetOption(portNum, attrNum)'.
+ 	result = -1 ifTrue: [interpreterProxy success: false. ^ 0].
+ 
+ 	interpreterProxy pop: 3.  "pop args and rcvr, push result"
+ 	interpreterProxy pushInteger: result.
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primIsPortOpen (in category 'serial port') -----
+ primIsPortOpen
+ 	"Answer the true if the given port is open."
+ 
+ 	| portNum result |
+ 	<export: true>
+ 	portNum := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	result := self cCode: 'SerialPortIsOpen(portNum)'.
+ 
+ 	interpreterProxy pop: 2.  "pop arg and rcvr"
+ 	interpreterProxy pushBool: result ~= 0.  "push result"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primOpenPortNamed (in category 'serial port') -----
+ primOpenPortNamed
+ 	"Open the port with the given name and baud rate."
+ 
+ 	| nameStr src nameOop baudRate count portNum |
+ 	<export: true>
+ 	<var: 'nameStr' declareC: 'char nameStr[1000]'>
+ 	<var: 'src' type: #'char *'>
+ 
+ 	nameOop := interpreterProxy stackValue: 1.
+ 	baudRate := interpreterProxy stackIntegerValue: 0.
+ 
+ 	interpreterProxy success: (interpreterProxy isBytes: nameOop).
+ 
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	src := self cCoerce: (interpreterProxy firstIndexableField: nameOop) to: #'char *'.
+ 	count := interpreterProxy stSizeOf: nameOop.
+ 	0 to: count - 1 do: [:i | nameStr at: i put: (src at: i)].
+ 	nameStr at: count put: 0.
+ 
+ 	portNum := self SerialPortOpen: nameStr PortNamed: baudRate.
+ 	portNum = -1 ifTrue: [interpreterProxy success: false. ^ 0].
+ 
+ 	interpreterProxy	"pop args and rcvr, push result"
+ 		pop: 3
+ 		thenPush: (interpreterProxy integerObjectOf: portNum).
+ 
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primPortCount (in category 'serial port') -----
+ primPortCount
+ 	"Answer the number of serial ports."
+ 
+ 	| result |
+ 	<export: true>
+ 
+ 	result := self cCode: 'SerialPortCount()'.
+ 	result = -1 ifTrue: [interpreterProxy success: false. ^ 0].
+ 
+ 	interpreterProxy
+ 		pop: 1 thenPush: (interpreterProxy integerObjectOf: result).  "pop rcvr, push result"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primPortName (in category 'serial port') -----
+ primPortName
+ 	"Get the name for the port with the given number. Fail if the port number is greater than the number of available ports. Port numbering starts with 1."
+ 
+ 	| portIndex nameStr count resultOop dst |
+ 	<export: true>
+ 	<var: 'nameStr' declareC: 'char nameStr[1000]'>
+ 	<var: 'dst' declareC: 'char* dst'>
+ 
+ 	portIndex := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	self cCode: 'SerialPortName(portIndex, nameStr, 1000)'.
+ 
+ 	count := self cCode: 'strlen(nameStr)'.
+ 	count = 0 ifTrue: [
+ 		interpreterProxy success: false.
+ 		^ 0].
+ 
+ 	resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: count.
+ 	dst := self cCoerce: (interpreterProxy firstIndexableField: resultOop) to: 'char *'.
+ 	0 to: count - 1 do: [:i | dst at: i put: (nameStr at: i)].
+ 
+ 	interpreterProxy pop: 2 thenPush: resultOop.  "pop arg and rcvr, push result"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primRead (in category 'serial port') -----
+ primRead
+ 	"Read data from the given serial port into the given buffer (a ByteArray or String). Answer the number of bytes read."
+ 
+ 	| portNum bufOop bytesRead |
+ 	<export: true>
+ 
+ 	portNum := interpreterProxy stackIntegerValue: 1.
+ 	bufOop := interpreterProxy stackValue: 0.
+ 
+ 	interpreterProxy success: (interpreterProxy isBytes: bufOop).
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	bytesRead := self Serial: portNum
+ 						Port: (self cCoerce: (interpreterProxy firstIndexableField: bufOop) to: 'char *')
+ 						Read: (interpreterProxy stSizeOf: bufOop).
+ 
+ 	interpreterProxy pop: 3.  					"pop args and rcvr"
+ 	interpreterProxy pushInteger: bytesRead.	"push result"
+ 	^ 0!

Item was added:
+ ----- Method: ScratchPlugin>>primSetOption (in category 'serial port') -----
+ primSetOption
+ 	"Return the given option value for the given serial port."
+ 
+ 	| portNum attrNum attrValue result |
+ 	<export: true>
+ 	portNum := interpreterProxy stackIntegerValue: 2.
+ 	attrNum := interpreterProxy stackIntegerValue: 1.
+ 	attrValue := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	result := self cCode: 'SerialPortSetOption(portNum, attrNum, attrValue)'.
+ 	result = -1 ifTrue: [interpreterProxy success: false. ^ 0].
+ 
+ 	interpreterProxy pop: 3.  "pop args; leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primWrite (in category 'serial port') -----
+ primWrite
+ 	"Write data to the given serial port from the given buffer (a ByteArray or String). Answer the number of bytes written."
+ 
+ 	| portNum bufOop bytesWritten |
+ 	<export: true>
+ 
+ 	portNum := interpreterProxy stackIntegerValue: 1.
+ 	bufOop := interpreterProxy stackValue: 0.
+ 
+ 	interpreterProxy success: (interpreterProxy isBytes: bufOop).
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	bytesWritten := self Serial: portNum
+ 						Port: (self cCoerce: (interpreterProxy firstIndexableField: bufOop) to: 'char *')
+ 						Write: (interpreterProxy stSizeOf: bufOop).
+ 
+ 	interpreterProxy pop: 3.  						"pop args and rcvr"
+ 	interpreterProxy pushInteger: bytesWritten.	"push result"
+ 	^ 0!

Item was added:
+ ----- Method: ScratchPlugin>>primitiveBlur (in category 'other filters') -----
+ primitiveBlur
+ 
+ 	| inOop outOop width in out sz height n rTotal gTotal bTotal pix outPix |
+ 	<export: true>
+ 	<var: 'in' declareC: 'unsigned int *in'>
+ 	<var: 'out' declareC: 'unsigned int *out'>
+ 
+ 	inOop := interpreterProxy stackValue: 2.
+ 	outOop := interpreterProxy stackValue: 1.
+ 	width := interpreterProxy stackIntegerValue: 0.
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	sz := interpreterProxy stSizeOf: inOop.
+ 	interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	height := sz // width.
+ 	1 to: height - 2 do: [:y |
+ 		1 to: width - 2 do: [:x |
+ 			n := rTotal := gTotal := bTotal := 0.
+ 			-1 to: 1 do: [:dY |
+ 				-1 to: 1 do: [:dX |
+ 					pix := (in at: ((y + dY) * width) + (x + dX) "add 1 when testing in Squeak") bitAnd: 16rFFFFFF.
+ 					pix = 0 ifFalse: [  "skip transparent pixels"
+ 						rTotal := rTotal + ((pix bitShift: -16) bitAnd: 16rFF).
+ 						gTotal := gTotal + ((pix bitShift: -8) bitAnd: 16rFF).
+ 						bTotal := bTotal + (pix bitAnd: 16rFF).
+ 						n := n + 1]]].
+ 			n = 0
+ 				ifTrue: [outPix :=  0]
+ 				ifFalse: [outPix := ((rTotal // n) bitShift: 16) + ((gTotal // n) bitShift: 8) +  (bTotal // n)].
+ 			out at: ((y * width) + x "add 1 when testing in Squeak") put: outPix]].
+ 
+ 	interpreterProxy pop: 3.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveBrightnessShift (in category 'hsv filters') -----
+ primitiveBrightnessShift
+ 
+ 	| inOop outOop shift in sz out pix r g b max min hue saturation brightness |
+ 	<export: true>
+ 	<var: 'in' declareC: 'unsigned int *in'>
+ 	<var: 'out' declareC: 'unsigned int *out'>
+ 
+ 	inOop := interpreterProxy stackValue: 2.
+ 	outOop := interpreterProxy stackValue: 1.
+ 	shift := interpreterProxy stackIntegerValue: 0.
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	sz := interpreterProxy stSizeOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	0 to: sz - 1 do: [:i |
+ 		pix := (in at: i) bitAnd: 16rFFFFFF.
+ 		pix = 0 ifFalse: [  "skip pixel values of 0 (transparent)"
+ 			r := (pix bitShift: -16) bitAnd: 16rFF.
+ 			g := (pix bitShift: -8) bitAnd: 16rFF.
+ 			b := pix bitAnd: 16rFF.
+ 
+ 			"find min and max color components"
+ 			max := min := r.
+ 			g > max ifTrue: [max := g].
+ 			b > max ifTrue: [max := b].
+ 			g < min ifTrue: [min := g].
+ 			b < min ifTrue: [min := b].
+ 
+ 			"find current hue with range 0 to 360"
+ 			hue := self hueFromR: r G: g B: b min: min max: max.
+ 
+ 			"find current saturation and brightness with range 0 to 1000"
+ 			max = 0 ifTrue: [saturation := 0] ifFalse: [saturation := ((max - min) * 1000) // max].
+ 			brightness := (max * 1000) // 255.
+ 
+ 			"compute new brigthness"
+ 			brightness := brightness + (shift * 10).
+ 			brightness > 1000 ifTrue: [brightness := 1000].
+ 			brightness < 0 ifTrue: [brightness := 0].
+ 
+ 			self bitmap: out at: i putH: hue s: saturation v: brightness]].
+ 
+ 	interpreterProxy pop: 3.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveCondenseSound (in category 'sound') -----
+ primitiveCondenseSound
+ 
+ 	| srcOop dstOop factor sz src dst count max v |
+ 	<export: true>
+ 	<var: 'src' declareC: 'short *src'>
+ 	<var: 'dst' declareC: 'short *dst'>
+ 
+ 	srcOop := interpreterProxy stackValue: 2.
+ 	dstOop := interpreterProxy stackValue: 1.
+ 	factor := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy success: (interpreterProxy isWords: srcOop).
+ 	interpreterProxy success: (interpreterProxy isWords: dstOop).
+ 
+ 	count := (2 * (interpreterProxy stSizeOf: srcOop)) // factor.
+ 	sz := 2 * (interpreterProxy stSizeOf: dstOop).
+ 	interpreterProxy success: (sz >= count).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	src := self cCoerce: (interpreterProxy firstIndexableField: srcOop) to: 'short *'.
+ 	dst := self cCoerce: (interpreterProxy firstIndexableField: dstOop) to: 'short *'.
+ 
+ 	1 to: count do: [:i |
+ 		max := 0.
+ 		1 to: factor do: [:j |
+ 			v := self cCode: '*src++'.
+ 			v < 0 ifTrue: [v := 0 - v].
+ 			v > max ifTrue: [max := v]].
+ 		self cCode: '*dst++ = max'].
+ 
+ 	interpreterProxy pop: 3.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveDoubleSize (in category 'scaling') -----
+ primitiveDoubleSize
+ 
+ 	| in out inOop outOop inW inH outW outH dstX dstY baseIndex pix i |
+ 	<export: true>
+ 	<var: 'in' declareC: 'int *in'>
+ 	<var: 'out' declareC: 'int *out'>
+ 
+ 	inOop := interpreterProxy stackValue: 7.
+ 	inW := interpreterProxy stackIntegerValue: 6.
+ 	inH := interpreterProxy stackIntegerValue: 5.
+ 	outOop := interpreterProxy stackValue: 4.
+ 	outW := interpreterProxy stackIntegerValue: 3.
+ 	outH := interpreterProxy stackIntegerValue: 2.
+ 	dstX := interpreterProxy stackIntegerValue: 1.
+ 	dstY := interpreterProxy stackIntegerValue: 0.
+ 
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	interpreterProxy success: (dstX + (2 * inW)) < outW.
+ 	interpreterProxy success: (dstY + (2 * inH)) < outH.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	0 to: inH - 1 do: [:y |
+ 		baseIndex := ((dstY + (2 * y)) * outW) + dstX.
+ 		0 to: inW - 1 do: [:x |
+ 			pix := in at: x + (y * inW).
+ 			i := baseIndex + (2 * x).
+ 			out at: i put: pix.
+ 			out at: i + 1 put: pix.
+ 			out at: i + outW put: pix.
+ 			out at: i + outW + 1 put: pix]].
+ 
+ 	interpreterProxy pop: 8.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveExtractChannel (in category 'sound') -----
+ primitiveExtractChannel
+ 
+ 	| srcOop dstOop rightFlag sz src dst |
+ 	<export: true>
+ 	<var: 'src' declareC: 'short *src'>
+ 	<var: 'dst' declareC: 'short *dst'>
+ 
+ 	srcOop := interpreterProxy stackValue: 2.
+ 	dstOop := interpreterProxy stackValue: 1.
+ 	rightFlag := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
+ 	interpreterProxy success: (interpreterProxy isWords: srcOop).
+ 	interpreterProxy success: (interpreterProxy isWords: dstOop).
+ 
+ 	sz := interpreterProxy stSizeOf: srcOop.
+ 	interpreterProxy success: ((interpreterProxy stSizeOf: dstOop) >= (sz // 2)).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	src := self cCoerce: (interpreterProxy firstIndexableField: srcOop) to: 'short *'.
+ 	dst := self cCoerce: (interpreterProxy firstIndexableField: dstOop) to: 'short *'.
+ 
+ 	rightFlag ifTrue: [self cCode: 'src++']. 
+ 	1 to: sz do: [:i | self cCode: '*dst++ = *src; src += 2'].
+ 
+ 	interpreterProxy pop: 3.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveFisheye (in category 'other filters') -----
+ primitiveFisheye
+ 
+ 	| inOop outOop width in out sz height centerX centerY dx dy ang pix power r srcX srcY scaledPower |
+ 	<export: true>
+ 	<var: 'in' type: #'unsigned int *'>
+ 	<var: 'out' type: #'unsigned int *'>
+ 	<var: 'dx' type: #double>
+ 	<var: 'dy' type: #double>
+ 	<var: 'ang' type: #double>
+ 	<var: 'r' type: #double>
+ 	<var: 'scaledPower' type: #double>
+ 
+ 	inOop := interpreterProxy stackValue: 3.
+ 	outOop := interpreterProxy stackValue: 2.
+ 	width := interpreterProxy stackIntegerValue: 1.
+ 	power := interpreterProxy stackIntegerValue: 0.
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	sz := interpreterProxy stSizeOf: inOop.
+ 	interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	"calculate height, center, scales, radius, whirlRadians, and radiusSquared"
+ 	height := sz // width.
+ 	centerX := width // 2.
+ 	centerY := height // 2.
+ 
+ 	height := sz // width.
+ 	centerX := width // 2.
+ 	centerY := height // 2.
+ 	scaledPower := power / 100.0.
+ 
+ 	0 to: width - 1 do: [:x |
+ 		0 to: height - 1 do: [:y |
+ 			dx := (x - centerX) / centerX asFloat.
+ 			dy := (y - centerY) / centerY asFloat.
+ 			r := ((dx * dx) + (dy * dy)) sqrt raisedTo: scaledPower.
+ 			r <= 1.0
+ 				ifTrue: [
+ 					ang := self cCode: 'atan2(dy,dx)'.
+ 					srcX := (1024 * (centerX + ((r * ang cos) * centerX))) asInteger.
+ 					srcY := (1024 * (centerY + ((r * ang sin) * centerY))) asInteger]
+ 				ifFalse: [
+ 					srcX := 1024 * x.
+ 					srcY := 1024 * y].
+ 			pix := self interpolatedFrom: in
+ 					x: srcX
+ 					y: srcY
+ 					width: width
+ 					height: height.
+ 			out at: ((y * width) + x "+ 1 for Squeak") put: pix]].
+ 
+ 	interpreterProxy pop: 4.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveGetFolderPath (in category 'os functions') -----
+ primitiveGetFolderPath
+ 	"Get the path for the special folder with given ID. Fail if the folder ID is out of range."
+ 
+ 	| nameStr dst folderID count resultOop |
+ 	<export: true>
+ 	<var: 'nameStr' declareC: 'char nameStr[2000]'>
+ 	<var: 'dst' declareC: 'char* dst'>
+ 
+ 	folderID := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	self cCode: 'GetFolderPathForID(folderID, nameStr, 2000)'.
+ 
+ 	count := self cCode: 'strlen(nameStr)'.
+ 	resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: count.
+ 	dst := self cCoerce: (interpreterProxy firstIndexableField: resultOop) to: 'char *'.
+ 	0 to: count - 1 do: [:i | dst at: i put: (nameStr at: i)].
+ 
+ 	interpreterProxy pop: 2 thenPush: resultOop.  "pop arg and rcvr, push result"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveHalfSizeAverage (in category 'scaling') -----
+ primitiveHalfSizeAverage
+ 
+ 	| in inW inH out outW outH srcX srcY dstX dstY dstW dstH srcIndex dstIndex pixel r g b |
+ 	<export: true>
+ 	<var: 'in' declareC: 'int *in'>
+ 	<var: 'out' declareC: 'int *out'>
+ 
+ 	in := self checkedUnsignedIntPtrOf: (interpreterProxy stackValue: 11).
+ 	inW := interpreterProxy stackIntegerValue: 10.
+ 	inH := interpreterProxy stackIntegerValue: 9.
+ 	out := self checkedUnsignedIntPtrOf: (interpreterProxy stackValue: 8).
+ 	outW := interpreterProxy stackIntegerValue: 7.
+ 	outH := interpreterProxy stackIntegerValue: 6.
+ 	srcX := interpreterProxy stackIntegerValue: 5.
+ 	srcY := interpreterProxy stackIntegerValue: 4.
+ 	dstX := interpreterProxy stackIntegerValue: 3.
+ 	dstY := interpreterProxy stackIntegerValue: 2.
+ 	dstW := interpreterProxy stackIntegerValue: 1.
+ 	dstH := interpreterProxy stackIntegerValue: 0.
+ 
+ 	interpreterProxy success: (srcX >= 0) & (srcY >= 0).
+ 	interpreterProxy success: (srcX + (2 * dstW)) <= inW.
+ 	interpreterProxy success: (srcY + (2 * dstH)) <= inH.
+ 	interpreterProxy success: (dstX >= 0) & (dstY >= 0).
+ 	interpreterProxy success: (dstX + dstW) <= outW.
+ 	interpreterProxy success: (dstY + dstH) <= outH.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	0 to: dstH - 1 do: [:y |
+ 		srcIndex := (inW * (srcY + (2 * y))) + srcX.
+ 		dstIndex := (outW * (dstY + y)) + dstX.
+ 		0 to: dstW - 1 do: [:x |
+ 			pixel := in at: srcIndex.
+ 			r := pixel bitAnd: 16rFF0000.
+ 			g := pixel bitAnd: 16rFF00.
+ 			b := pixel bitAnd: 16rFF.
+ 
+ 			pixel := in at: srcIndex + 1.
+ 			r := r + (pixel bitAnd: 16rFF0000).
+ 			g := g + (pixel bitAnd: 16rFF00).
+ 			b := b + (pixel bitAnd: 16rFF).
+ 
+ 			pixel := in at: srcIndex + inW.
+ 			r := r + (pixel bitAnd: 16rFF0000).
+ 			g := g + (pixel bitAnd: 16rFF00).
+ 			b := b + (pixel bitAnd: 16rFF).
+ 
+ 			pixel := in at: srcIndex + inW + 1.
+ 			r := r + (pixel bitAnd: 16rFF0000).
+ 			g := g + (pixel bitAnd: 16rFF00).
+ 			b := b + (pixel bitAnd: 16rFF).
+ 
+ 			"store combined RGB into target bitmap"
+ 			out at: dstIndex put:
+ 				(((r bitShift: -2) bitAnd: 16rFF0000) bitOr:
+ 				(((g bitShift: -2) bitAnd: 16rFF00) bitOr: (b bitShift: -2))).
+ 
+ 			srcIndex := srcIndex + 2.
+ 			dstIndex := dstIndex + 1]].
+ 
+ 	interpreterProxy pop: 12.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveHalfSizeDiagonal (in category 'scaling') -----
+ primitiveHalfSizeDiagonal
+ 
+ 	| in inW inH out outW outH srcX srcY dstX dstY dstW dstH srcIndex dstIndex p1 p2 r g b |
+ 	<export: true>
+ 	<var: 'in' declareC: 'int *in'>
+ 	<var: 'out' declareC: 'int *out'>
+ 
+ 	in := self checkedUnsignedIntPtrOf: (interpreterProxy stackValue: 11).
+ 	inW := interpreterProxy stackIntegerValue: 10.
+ 	inH := interpreterProxy stackIntegerValue: 9.
+ 	out := self checkedUnsignedIntPtrOf: (interpreterProxy stackValue: 8).
+ 	outW := interpreterProxy stackIntegerValue: 7.
+ 	outH := interpreterProxy stackIntegerValue: 6.
+ 	srcX := interpreterProxy stackIntegerValue: 5.
+ 	srcY := interpreterProxy stackIntegerValue: 4.
+ 	dstX := interpreterProxy stackIntegerValue: 3.
+ 	dstY := interpreterProxy stackIntegerValue: 2.
+ 	dstW := interpreterProxy stackIntegerValue: 1.
+ 	dstH := interpreterProxy stackIntegerValue: 0.
+ 
+ 	interpreterProxy success: (srcX >= 0) & (srcY >= 0).
+ 	interpreterProxy success: (srcX + (2 * dstW)) <= inW.
+ 	interpreterProxy success: (srcY + (2 * dstH)) <= inH.
+ 	interpreterProxy success: (dstX >= 0) & (dstY >= 0).
+ 	interpreterProxy success: (dstX + dstW) <= outW.
+ 	interpreterProxy success: (dstY + dstH) <= outH.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	0 to: dstH - 1 do: [:y |
+ 		srcIndex := (inW * (srcY + (2 * y))) + srcX.
+ 		dstIndex := (outW * (dstY + y)) + dstX.
+ 		0 to: dstW - 1 do: [:x |
+ 			p1 := in at: srcIndex.
+ 			p2 := in at: srcIndex + inW + 1.
+ 
+ 			r := (((p1 bitAnd: 16rFF0000) + (p2 bitAnd: 16rFF0000)) bitShift: -1) bitAnd: 16rFF0000.
+ 			g := (((p1 bitAnd: 16rFF00) + (p2 bitAnd: 16rFF00)) bitShift: -1) bitAnd: 16rFF00.
+ 			b := ((p1 bitAnd: 16rFF) + (p2 bitAnd: 16rFF)) bitShift: -1.
+ 
+ 			"store combined RGB into target bitmap"
+ 			out at: dstIndex put: (r bitOr: (g bitOr: b)).
+ 
+ 			srcIndex := srcIndex + 2.
+ 			dstIndex := dstIndex + 1]].
+ 
+ 	interpreterProxy pop: 12.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveHueShift (in category 'hsv filters') -----
+ primitiveHueShift
+ 
+ 	| inOop outOop shift in sz out pix r g b max min brightness saturation hue |
+ 	<export: true>
+ 	<var: 'in' declareC: 'unsigned int *in'>
+ 	<var: 'out' declareC: 'unsigned int *out'>
+ 
+ 	inOop := interpreterProxy stackValue: 2.
+ 	outOop := interpreterProxy stackValue: 1.
+ 	shift := interpreterProxy stackIntegerValue: 0.
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	sz := interpreterProxy stSizeOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	0 to: sz - 1 do: [:i |
+ 		pix := (in at: i) bitAnd: 16rFFFFFF.
+ 		pix = 0 ifFalse: [  "skip pixel values of 0 (transparent)"
+ 			r := (pix bitShift: -16) bitAnd: 16rFF.
+ 			g := (pix bitShift: -8) bitAnd: 16rFF.
+ 			b := pix bitAnd: 16rFF.
+ 
+ 			"find min and max color components"
+ 			max := min := r.
+ 			g > max ifTrue: [max := g].
+ 			b > max ifTrue: [max := b].
+ 			g < min ifTrue: [min := g].
+ 			b < min ifTrue: [min := b].
+ 
+ 			"find current brightness (v) and  saturation with range 0 to 1000"
+ 			brightness := (max * 1000) // 255.
+ 			max = 0 ifTrue: [saturation := 0] ifFalse: [saturation := ((max - min) * 1000) // max].
+ 
+ 			brightness < 110 ifTrue: [					"force black to a very dark, saturated gray"
+ 				brightness := 110. saturation := 1000].	
+ 			saturation < 90 ifTrue: [saturation := 90].		"force a small color change on grays"
+ 			((brightness = 110) | (saturation = 90))		"tint all blacks and grays the same"
+ 				ifTrue: [hue := 0]
+ 				ifFalse: [hue := self hueFromR: r G: g B: b min: min max: max].
+ 
+ 			hue := (hue + shift + 360000000) \\ 360.  "compute new hue"
+ 			self bitmap: out at: i putH: hue s: saturation v: brightness]].
+ 
+ 	interpreterProxy pop: 3.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveInterpolate (in category 'bilinear interpolation') -----
+ primitiveInterpolate
+ 
+ 	| inOop xFixed yFixed width in sz result |
+ 	<export: true>
+ 	<var: 'in' declareC: 'unsigned int *in'>
+ 
+ 	inOop := interpreterProxy stackValue: 3.
+ 	width := interpreterProxy stackIntegerValue: 2.
+ 	xFixed := interpreterProxy stackIntegerValue: 1.
+ 	yFixed := interpreterProxy stackIntegerValue: 0.
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	sz := interpreterProxy stSizeOf: inOop.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	result := self interpolatedFrom: in x: xFixed y: yFixed width: width height: sz // width.
+ 
+ 	interpreterProxy pop: 5.  "pop args and rcvr"
+ 	interpreterProxy pushInteger: result.
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveIsHidden (in category 'os functions') -----
+ primitiveIsHidden
+ 	"Answer true if the file or folder with the given path should be hidden from the user. On Windows, this is the value of the 'hidden' file property."
+ 
+ 	| pathOop src count fullPath result |
+ 	<export: true>
+ 	<var: 'fullPath' declareC: 'char fullPath[1000]'>
+ 	<var: 'src' type: #'char *'>
+ 
+ 	pathOop := interpreterProxy stackValue: 0.
+ 
+ 	interpreterProxy success: (interpreterProxy isBytes: pathOop).
+ 
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	src := self cCoerce: (interpreterProxy firstIndexableField: pathOop) to: #'char *'.
+ 	count := interpreterProxy stSizeOf: pathOop.
+ 	count >= 1000 ifTrue: [interpreterProxy success: false. ^ 0].
+ 	0 to: count - 1 do: [:i | fullPath at: i put: (src at: i)].
+ 	fullPath at: count put: 0.
+ 
+ 	result := self IsFileOrFolderHidden: fullPath.
+ 
+ 	interpreterProxy pop: 2.  "pop arg and rcvr"
+ 	interpreterProxy pushBool: result ~= 0.  "push result"
+ 	^ 0!

Item was added:
+ ----- Method: ScratchPlugin>>primitiveOpenURL (in category 'os functions') -----
+ primitiveOpenURL
+ 	"Open a web browser on the given URL."
+ 
+ 	| urlStr src urlOop count |
+ 	<export: true>
+ 	<var: 'urlStr' declareC: 'char urlStr[2000]'>
+ 	<var: 'src' type: #'char *'>
+ 
+ 	urlOop := interpreterProxy stackValue: 0.
+ 
+ 	interpreterProxy success: (interpreterProxy isBytes: urlOop).
+ 
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	src := self cCoerce: (interpreterProxy firstIndexableField: urlOop) to: #'char *'.
+ 	count := interpreterProxy stSizeOf: urlOop.
+ 	count >= 2000 ifTrue: [interpreterProxy success: false. ^ 0].
+ 	0 to: count - 1 do: [:i | urlStr at: i put: (src at: i)].
+ 	urlStr at: count put: 0.
+ 
+ 	self OpenURL: urlStr.
+ 
+ 	interpreterProxy pop: 1.  "pop arg, leave rcvr on stack"
+ 	^ 0!

Item was added:
+ ----- Method: ScratchPlugin>>primitiveSaturationShift (in category 'hsv filters') -----
+ primitiveSaturationShift
+ 
+ 	| inOop outOop shift in sz out pix r g b max min brightness saturation hue |
+ 	<export: true>
+ 	<var: 'in' declareC: 'unsigned int *in'>
+ 	<var: 'out' declareC: 'unsigned int *out'>
+ 
+ 	inOop := interpreterProxy stackValue: 2.
+ 	outOop := interpreterProxy stackValue: 1.
+ 	shift := interpreterProxy stackIntegerValue: 0.
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	sz := interpreterProxy stSizeOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	0 to: sz - 1 do: [:i |
+ 		pix := (in at: i) bitAnd: 16rFFFFFF.
+ 		pix < 2 ifFalse: [  "skip pixel values of 0 (transparent) and 1 (black)"
+ 			r := (pix bitShift: -16) bitAnd: 16rFF.
+ 			g := (pix bitShift: -8) bitAnd: 16rFF.
+ 			b := pix bitAnd: 16rFF.
+ 
+ 			"find min and max color components"
+ 			max := min := r.
+ 			g > max ifTrue: [max := g].
+ 			b > max ifTrue: [max := b].
+ 			g < min ifTrue: [min := g].
+ 			b < min ifTrue: [min := b].
+ 
+ 			"find current brightness (v) and  saturation with range 0 to 1000"
+ 			brightness := (max * 1000) // 255.
+ 			max = 0 ifTrue: [saturation := 0] ifFalse: [saturation := ((max - min) * 1000) // max].
+ 
+ 			saturation > 0 ifTrue: [  "do nothing if pixel is unsaturated (gray)"
+ 				hue := self hueFromR: r G: g B: b min: min max: max.
+ 
+ 				"compute new saturation"
+ 				saturation := saturation + (shift * 10).
+ 				saturation > 1000 ifTrue: [saturation := 1000].
+ 				saturation < 0 ifTrue: [saturation := 0].
+ 				self bitmap: out at: i putH: hue s: saturation v: brightness]]].
+ 
+ 	interpreterProxy pop: 3.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveScale (in category 'scaling') -----
+ primitiveScale
+ 	"Scale using bilinear interpolation."
+ 	"This version isn't really able to do much with full ARGB based images; the A channel will be ignored and only fully transparent pixels will be treated as transparent. The output pixel will be either fully transparent or fully opaque."
+ 
+ 	| inOop inW inH outOop outW outH in out inX inY xIncr yIncr outPix w1 w2 w3 w4 t p1 p2 p3 p4 tWeight |
+ 	<export: true>
+ 	<var: 'in' declareC: 'int *in'>
+ 	<var: 'out' declareC: 'int *out'>
+ 
+ 	inOop := interpreterProxy stackValue: 5.
+ 	inW := interpreterProxy stackIntegerValue: 4.
+ 	inH := interpreterProxy stackIntegerValue: 3.
+ 	outOop := interpreterProxy stackValue: 2.
+ 	outW := interpreterProxy stackIntegerValue: 1.
+ 	outH := interpreterProxy stackIntegerValue: 0.
+ 
+ 	interpreterProxy success: (interpreterProxy stSizeOf: inOop) = (inW * inH).
+ 	interpreterProxy success: (interpreterProxy stSizeOf: outOop) = (outW * outH).
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	inX := inY := 0.					"source x and y, scaled by 1024"
+ 	xIncr := (inW * 1024) // outW.	"source x increment, scaled by 1024"
+ 	yIncr := (inH * 1024) // outH.		"source y increment, scaled by 1024"
+ 
+ 	0 to: (outH - 1) do: [:outY |
+ 		inX := 0.
+ 		0 to: (outW - 1) do: [:outX |
+ 			"compute weights, scaled by 2^20"
+ 			w1 := (1024 - (inX bitAnd: 1023))	* (1024 - (inY bitAnd: 1023)).
+ 			w2 := (inX bitAnd: 1023)			* (1024 - (inY bitAnd: 1023)).
+ 			w3 := (1024 - (inX bitAnd: 1023))	* (inY bitAnd: 1023).
+ 			w4 := (inX bitAnd: 1023)			* (inY bitAnd: 1023).
+ 
+ 			"get source pixels"
+ 			t := ((inY >> 10) * inW) + (inX >> 10).
+ 			p1 := in at: t.
+ 			((inX >> 10) < (inW - 1)) ifTrue: [p2 := in at: t + 1] ifFalse: [p2 := p1].
+ 			(inY >> 10) < (inH - 1) ifTrue: [t := t + inW].  "next row"
+ 			p3 := in at: t.
+ 			((inX >> 10) < (inW - 1)) ifTrue: [p4 := in at: t + 1] ifFalse: [p4 := p3].
+ 
+ 			"deal with transparent pixels"
+ 			"Note as above - only transparent not translucent"
+ 			tWeight := 0.
+ 			p1 = 0 ifTrue: [p1 := p2. tWeight := tWeight + w1].
+ 			p2 = 0 ifTrue: [p2 := p1. tWeight := tWeight + w2].
+ 			p3 = 0 ifTrue: [p3 := p4. tWeight := tWeight + w3].
+ 			p4 = 0 ifTrue: [p4 := p3. tWeight := tWeight + w4].
+ 			p1 = 0 ifTrue: [p1 := p3. p2 := p4].  "both top pixels were transparent; use bottom row"
+ 			p3 = 0 ifTrue: [p3 := p1. p4 := p2].  "both bottom pixels were transparent; use top row"
+ 
+ 			outPix := 0.
+ 			tWeight < 500000 ifTrue: [  "compute an (opaque) output pixel if less than 50% transparent"
+ 				t := (w1 * ((p1 >> 16) bitAnd: 255)) + (w2 * ((p2 >> 16) bitAnd: 255)) + (w3 * ((p3 >> 16) bitAnd: 255)) + (w4 * ((p4 >> 16) bitAnd: 255)).
+ 				outPix := ((t >> 20) bitAnd: 255) << 16.
+ 				t := (w1 * ((p1 >> 8) bitAnd: 255)) + (w2 * ((p2 >> 8) bitAnd: 255)) + (w3 * ((p3 >> 8) bitAnd: 255)) + (w4 * ((p4 >> 8) bitAnd: 255)).
+ 				outPix := outPix bitOr: (((t >> 20) bitAnd: 255) << 8).
+ 				t := (w1 * (p1 bitAnd: 255)) + (w2 * (p2 bitAnd: 255)) + (w3 * (p3 bitAnd: 255)) + (w4 * (p4 bitAnd: 255)).
+ 				outPix := outPix bitOr: ((t >> 20) bitAnd: 255).
+ 				"If the result is black, remember to make it Squeak-standard-fake-black"
+ 				outPix = 0 ifTrue: [outPix := 1].
+ 				"add the A channel to make it really opaque"
+ 				outPix := outPix bitOr: 16rFF000000].
+ 
+ 			out at: (outY * outW) + outX put: outPix.
+ 			inX := inX + xIncr].
+ 		inY := inY + yIncr].
+ 
+ 	interpreterProxy pop: 6.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveSetUnicodePasteBuffer (in category 'os functions') -----
+ primitiveSetUnicodePasteBuffer
+ 	"Set the Mac OS X Unicode paste buffer."
+ 
+ 	| utf16 strOop count |
+ 	<export: true>
+ 	<var: 'utf16' declareC: 'short *utf16'>
+ 
+ 	strOop := interpreterProxy stackValue: 0.
+ 
+ 	interpreterProxy success: (interpreterProxy isBytes: strOop).
+ 
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	utf16 := self cCoerce: (interpreterProxy firstIndexableField: strOop) to: #'short *'.
+ 	count := interpreterProxy stSizeOf: strOop.
+ 
+ 	self SetUnicodePaste: utf16 Buffer: count.
+ 
+ 	interpreterProxy pop: 1.  "pop arg, leave rcvr on stack"
+ 	^ 0!

Item was added:
+ ----- Method: ScratchPlugin>>primitiveSetWindowTitle (in category 'os functions') -----
+ primitiveSetWindowTitle
+ 	"Set the title of the Scratch window."
+ 
+ 	| titleStr src titleOop count |
+ 	<export: true>
+ 	<var: 'titleStr' declareC: 'char titleStr[1000]'>
+ 	<var: 'src' type: #'char *'>
+ 
+ 	titleOop := interpreterProxy stackValue: 0.
+ 
+ 	interpreterProxy success: (interpreterProxy isBytes: titleOop).
+ 
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	src := self cCoerce: (interpreterProxy firstIndexableField: titleOop) to: #'char *'.
+ 	count := interpreterProxy stSizeOf: titleOop.
+ 	count >= 1000 ifTrue: [interpreterProxy success: false. ^ 0].
+ 	0 to: count - 1 do: [:i | titleStr at: i put: (src at: i)].
+ 	titleStr at: count put: 0.
+ 
+ 	self SetScratchWindowTitle: titleStr.
+ 
+ 	interpreterProxy pop: 1.  "pop arg, leave rcvr on stack"
+ 	^ 0!

Item was added:
+ ----- Method: ScratchPlugin>>primitiveShortToLongPath (in category 'os functions') -----
+ primitiveShortToLongPath
+ 	"On Windows, convert a short file/path name into a long one. Fail on other platforms."
+ 
+ 	| shortPath longPath ptr shortPathOop result count resultOop |
+ 	<export: true>
+ 	<var: 'shortPath' declareC: 'char shortPath[1000]'>
+ 	<var: 'longPath' declareC: 'char longPath[1000]'>
+ 	<var: 'ptr' type: #'char *'>
+ 
+ 	shortPathOop := interpreterProxy stackValue: 0.
+ 
+ 	(interpreterProxy isBytes: shortPathOop) ifFalse:
+ 		[interpreterProxy success: false. ^ 0].
+ 
+ 	ptr := self cCoerce: (interpreterProxy firstIndexableField: shortPathOop) to: #'char *'.
+ 	count := interpreterProxy stSizeOf: shortPathOop.
+ 	count >= 1000 ifTrue: [interpreterProxy success: false. ^ 0].
+ 	0 to: count - 1 do: [:i | shortPath at: i put: (ptr at: i)].
+ 	shortPath at: count put: 0.
+ 
+ 	result := self cCode: 'WinShortToLongPath(shortPath, longPath, 1000)'.
+ 	result = -1 ifTrue: [interpreterProxy success: false. ^ 0].
+ 
+ 	count := self strlen: longPath.
+ 	resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: count.
+ 	ptr := self cCoerce: (interpreterProxy firstIndexableField: resultOop) to: #'char *'.
+ 	0 to: count - 1 do: [:i | ptr at: i put: (longPath at: i)].
+ 
+ 	interpreterProxy pop: 2 thenPush: resultOop.  "pop arg and rcvr, push result"
+ 	^ 0!

Item was added:
+ ----- Method: ScratchPlugin>>primitiveWaterRipples1 (in category 'other filters') -----
+ primitiveWaterRipples1
+  
+ 	| in out aArray bArray ripply temp pix dx dy dist inOop outOop width allPix aArOop bArOop height t1 blops x y power val val2 dx2 dy2 newLoc |
+ 	<export: true>
+ 	<var: 'in' declareC: 'unsigned int *in'>
+ 	<var: 'out' declareC: 'unsigned int *out'>
+ 	<var: 'aArray' declareC: 'double *aArray'>
+ 	<var: 'bArray' declareC: 'double *bArray'>
+ 	<var: 'ripply' declareC: 'int ripply'>
+ 	<var: 'temp' declareC: 'double temp'>
+ 	<var: 'pix' declareC: 'unsigned int pix'>
+ 	<var: 'dist' declareC: 'double dist'>
+ 	<var: 'dx2' declareC: 'double dx2'>
+ 	<var: 'dy2' declareC: 'double dy2'>
+ 
+ 	inOop := interpreterProxy stackValue: 5.
+ 	outOop := interpreterProxy stackValue: 4.
+ 	width := interpreterProxy stackIntegerValue: 3.
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	allPix := interpreterProxy stSizeOf: inOop.
+ 	ripply := interpreterProxy stackIntegerValue: 2.
+ 	aArOop := interpreterProxy stackValue: 1.
+ 	bArOop := interpreterProxy stackValue: 0.
+ 	aArray := self checkedFloatPtrOf: aArOop.
+ 	bArray := self checkedFloatPtrOf: bArOop.
+ 	interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = allPix).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	height := allPix // width.
+ 
+ 	t1 := self cCode: 'rand()'.
+ 	blops := t1 \\ ripply -1.
+ 	0 to: blops /2-1 do: [:t |
+ 		t1 := self cCode: 'rand()'.
+ 		x := t1 \\ width.
+ 		t1 := self cCode: 'rand()'.
+ 		y := t1 \\ height.
+ 		t1 := self cCode: 'rand()'.
+ 		power := t1 \\ 8.
+ 		-4 to: 4 do: [:g |
+ 			-4 to: 4 do: [:h |
+ 				dist := ((g*g) + (h*h)) asFloat.
+ 				((dist < 25) and: [dist > 0]) ifTrue: [
+ 						dx := (x + g) asInteger.
+ 						dy := (y + h) asInteger.
+ 						((dx >0) and: [(dy>0) and: [(dy < height) and: [dx < width]]]) ifTrue: [
+ 							aArray at: ((dy)*width + dx) put: (power *(1.0 asFloat -(dist/(25.0 asFloat))) asFloat).
+ 						].
+ 					].
+ 				].
+ 			].
+ 		].
+ 	
+ 		1 to: width -2 do: [:f |
+ 			1 to: height -2 do: [:d |
+ 			val := (d)*width + f.
+ 			aArray at: val put: (((
+ 				(bArray at: (val+1)) + (bArray at: (val-1)) + (bArray at: (val + width)) + (bArray at: (val - width)) +
+ 				((bArray at: (val -1 -width))/2) + ((bArray at: (val-1+width))/2) + ((bArray at: (val+1-width))/2) + ((bArray at: (val+1+width))/2)) /4) - (aArray at: (val))).
+ 			aArray at: (val) put: ((aArray at: (val))*(0.9 asFloat)).
+ 			].
+ 		].
+ 	
+ 		"temp := bArray.
+ 		bArray := aArray.
+ 		aArray := temp."
+ 		0 to: width*height do: [:q |
+ 			temp := bArray at: q.
+ 			bArray at: q put: (aArray at: q).
+ 			aArray at: q put: temp.
+ 		].
+ 
+ 		0 to: height-1 do: [:j |
+ 			0 to: width-1 do: [:i |
+ 				((i > 1) and: [(i<(width-1)) and: [(j>1) and: [(j<(height-1))]]]) ifTrue: [
+ 					val2 := (j)*width + i.
+ 					dx2 := ((((aArray at: (val2)) - (aArray at: (val2-1))) + ((aArray at: (val2+1)) - (aArray at: (val2)))) *64) asFloat.
+ 					dy2 := ((((aArray at: (val2)) - (aArray at: (val2-width))) + ((aArray at: (val2+width)) - (aArray at: (val2)))) /64) asFloat.
+ 					(dx2 < -2) ifTrue: [dx2 := -2].
+ 					(dx2 >  2) ifTrue: [dx2 :=  2].
+ 					(dy2 < -2) ifTrue: [dy2 := -2].
+ 					(dy2 >  2) ifTrue: [dy2 :=  2].
+ 					newLoc := ((j+dy2)*width + (i+dx2)) asInteger.
+ 					((newLoc < (width*height)) and: [newLoc >=0]) ifTrue: [
+ 						pix := in at: newLoc]
+ 					ifFalse: [
+ 						pix := in at: (i +(j*width)) ].
+ 				]
+ 				ifFalse: [
+ 					pix := in at: (i +(j*width)) ].
+ 			out at: (i + (j*width)) put: pix.
+ 		]].
+ 
+ 	interpreterProxy pop: 6.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveWhirl (in category 'other filters') -----
+ primitiveWhirl
+ 
+ 	| inOop outOop width degrees in out sz height centerX centerY radius scaleX scaleY whirlRadians radiusSquared dx dy d factor ang sina cosa pix |
+ 	<export: true>
+ 	<var: 'in' declareC: 'unsigned int *in'>
+ 	<var: 'out' declareC: 'unsigned int *out'>
+ 	<var: 'scaleX' declareC: 'double scaleX'>
+ 	<var: 'scaleY' declareC: 'double scaleY'>
+ 	<var: 'whirlRadians' declareC: 'double whirlRadians'>
+ 	<var: 'radiusSquared' declareC: 'double radiusSquared'>
+ 	<var: 'dx' declareC: 'double dx'>
+ 	<var: 'dy' declareC: 'double dy'>
+ 	<var: 'd' declareC: 'double d'>
+ 	<var: 'factor' declareC: 'double factor'>
+ 	<var: 'ang' declareC: 'double ang'>
+ 	<var: 'sina' declareC: 'double sina'>
+ 	<var: 'cosa' declareC: 'double cosa'>
+ 
+ 	inOop := interpreterProxy stackValue: 3.
+ 	outOop := interpreterProxy stackValue: 2.
+ 	width := interpreterProxy stackIntegerValue: 1.
+ 	degrees := interpreterProxy stackIntegerValue: 0.
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	sz := interpreterProxy stSizeOf: inOop.
+ 	interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	"calculate height, center, scales, radius, whirlRadians, and radiusSquared"
+ 	height := sz // width.
+ 	centerX := width // 2.
+ 	centerY := height // 2.
+ 	centerX < centerY
+ 		ifTrue: [
+ 			radius := centerX.
+ 			scaleX := centerY asFloat / centerX. 
+ 			scaleY := 1.0]
+ 		ifFalse: [
+ 			radius := centerY.
+ 			scaleX := 1.0.
+ 			centerY < centerX
+ 				ifTrue: [scaleY := centerX asFloat / centerY]
+ 				ifFalse: [scaleY := 1.0]].
+ 	whirlRadians := (-3.141592653589793 * degrees) / 180.0.
+ 	radiusSquared := (radius * radius) asFloat.
+ 
+ 	0 to: width - 1 do: [:x |
+ 		0 to: height - 1 do: [:y |
+ 			dx := scaleX * (x - centerX) asFloat.
+ 			dy := scaleY * (y - centerY) asFloat.
+ 			d := (dx * dx) + (dy * dy).
+ 			d < radiusSquared ifTrue: [  "inside the whirl circle"
+ 				factor := 1.0 - (d sqrt / radius).
+ 				ang := whirlRadians * (factor * factor).
+ 				sina := ang sin.
+ 				cosa := ang cos.
+ 				pix := self interpolatedFrom: in
+ 					x: (1024.0 * ((((cosa * dx) - (sina * dy)) / scaleX) + centerX)) asInteger
+ 					y: (1024.0 * ((((sina * dx) + (cosa * dy)) / scaleY) + centerY)) asInteger
+ 					width: width
+ 					height: height.
+ 				out at: ((width * y) + x "for Squeak: + 1") put: pix]]].
+ 
+ 	interpreterProxy pop: 4.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScriptActivationButton>>editButtonsScript (in category '*Etoys-Squeakland-button') -----
+ editButtonsScript
+ 	"Open the scriptor for the script activated by this button."
+ 
+ 	target openUnderlyingScriptorFor: arguments first!

Item was changed:
  ----- Method: ScriptActivationButton>>establishLabelWording (in category 'label') -----
  establishLabelWording
  	"Set the label wording, unless it has already been manually edited"
  
  	| itsName |
+ 	itsName _ target externalName.
- 	itsName := target externalName.
  	(self hasProperty: #labelManuallyEdited)
  		ifFalse:
+ 			[self label: (itsName, ' ', arguments first) font: Preferences standardEToysButtonFont].
- 			[self label: (itsName, ' ', arguments first)].
  	self setBalloonText: 
  		('click to run the script "{1}" in player named "{2}"' translated format: {arguments first. itsName}).
  !

Item was changed:
  ----- Method: ScriptActivationButton>>setLabel (in category 'miscellaneous') -----
  setLabel
  	"Allow the user to enter a new label for this button"
  
  	| newLabel existing |
+ 	existing _ self label.
+ 	newLabel _ FillInTheBlank
+ 		request: 'Please enter a new label for this button' translated
- 	existing := self label.
- 	newLabel := UIManager default
- 		request: 'Please enter a new label for this button'
  		initialAnswer: existing.
  	(newLabel isEmptyOrNil not and: [newLabel ~= existing]) ifTrue:
  		[self setProperty: #labelManuallyEdited toValue: true.
+ 		self label: newLabel font: Preferences standardEToysButtonFont].
- 		self label: newLabel].
  !

Item was added:
+ Compiler subclass: #ScriptCompiler
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Compiler'!

Item was added:
+ ----- Method: ScriptCompiler class>>parserClass (in category 'accessing') -----
+ parserClass
+ 
+ 	^ ScriptParser!

Item was added:
+ ----- Method: ScriptCompiler>>compile:in:notifying:ifFail: (in category 'as yet unclassified') -----
+ compile: textOrStream in: aClass notifying: aRequestor ifFail: failBlock
+ 	
+ 	self parserClass: ScriptParser.
+ 	^ super compile: textOrStream in: aClass notifying: aRequestor ifFail: failBlock!

Item was added:
+ ----- Method: ScriptCompiler>>compile:in:notifying:ifFail:for: (in category 'as yet unclassified') -----
+ compile: textOrStream in: aClass notifying: aRequestor ifFail: failBlock for: anInstance
+ 	"Answer a MethodNode for the argument, textOrStream. If the 
+ 	MethodNode can not be created, notify the argument, aRequestor; if 
+ 	aRequestor is nil, evaluate failBlock instead. The MethodNode is the root 
+ 	of a parse tree. It can be told to generate a CompiledMethod to be 
+ 	installed in the method dictionary of the argument, aClass."
+ 
+ 	self parserClass: ScriptParser.
+ 	^ self parser
+ 		parse: textOrStream readStream
+ 		class: aClass
+ 		noPattern: false
+ 		context: nil
+ 		notifying: aRequestor
+ 		ifFail: [^ failBlock value] for: anInstance.
+ !

Item was added:
+ ----- Method: ScriptCompiler>>evaluate:in:to:notifying:ifFail:logged: (in category 'as yet unclassified') -----
+ evaluate: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock logged: logFlag
+ 	"Compiles the sourceStream into a parse tree, then generates code into a 
+ 	method. This method is then installed in the receiver's class so that it 
+ 	can be invoked. In other words, if receiver is not nil, then the text can 
+ 	refer to instance variables of that receiver (the Inspector uses this). If 
+ 	aContext is not nil, the text can refer to temporaries in that context (the 
+ 	Debugger uses this). If aRequestor is not nil, then it will receive a 
+ 	notify:at: message before the attempt to evaluate is aborted. Finally, the 
+ 	compiled method is invoked from here as DoIt or (in the case of 
+ 	evaluation in aContext) DoItIn:. The method is subsequently removed 
+ 	from the class, but this will not get done if the invocation causes an 
+ 	error which is terminated. Such garbage can be removed by executing: 
+ 	Smalltalk allBehaviorsDo: [:cl | cl removeSelector: #DoIt; removeSelector: 
+ 	#DoItIn:]."
+ 
+ 	| class methodNode method value selector toLog itsSelectionString itsSelection |
+ 	class := (aContext == nil ifTrue: [receiver] ifFalse: [aContext receiver]) class.
+ 	methodNode :=  self parser new
+ 		parse: textOrStream readStream
+ 		class: class
+ 		noPattern: true
+ 		context: aContext
+ 		notifying: aRequestor
+ 		ifFail: [^ failBlock value] for: receiver.
+ 	method _ methodNode generate: CompiledMethodTrailer empty.
+ 	self interactive ifTrue:
+ 		[method _ method copyWithTempNames: methodNode tempNames].
+ 	
+ 	selector _ aContext isNil
+ 		ifTrue: [#DoIt]
+ 		ifFalse: [#DoItIn:].
+ 	class addSelectorSilently: selector withMethod: method.
+ 	value _ aContext isNil
+ 		ifTrue: [receiver DoIt]
+ 		ifFalse: [receiver DoItIn: aContext].
+ 	InMidstOfFileinNotification signal 
+ 		ifFalse: [class basicRemoveSelector: selector].
+ 	logFlag ifTrue:
+ 		[toLog _ ((aRequestor respondsTo: #selection)  and:
+ 			[(itsSelection := aRequestor selection) notNil] and:
+ 			[(itsSelectionString _ itsSelection asString) isEmptyOrNil not] )
+ 			ifTrue:
+ 				[itsSelectionString]
+ 			ifFalse:
+ 				[textOrStream readStream contents].
+ 
+ 		SystemChangeNotifier uniqueInstance evaluated: toLog context: aContext].
+ 
+ 	^ value!

Item was changed:
  AlignmentMorph subclass: #ScriptEditorMorph
+ 	instanceVariableNames: 'scriptName firstTileRow timeStamp playerScripted handWithTile showingMethodPane threadPolygon previousDropHandPosition dropSpaces'
+ 	classVariableNames: 'Evaluator GenerateParseNodeDirectly Rewrite WritingUniversalTiles'
- 	instanceVariableNames: 'scriptName firstTileRow timeStamp playerScripted handWithTile showingMethodPane threadPolygon'
- 	classVariableNames: 'WritingUniversalTiles'
  	poolDictionaries: ''
  	category: 'Etoys-Scripting'!
  
  !ScriptEditorMorph commentStamp: '<historical>' prior: 0!
  Presents an EToy script to the user on the screen.  Has in it:
  
  a Morph with the controls for the script.
  a Morph with the tiles.  Either PhraseMorphs and TileMorphs, 
  	or a TwoWayScroller with SyntaxMorphs in it.
  
  WritingUniversalTiles -- only vlaid while a project is being written out.  
  		True if using UniversalTiles in that project.!

Item was added:
+ ----- Method: ScriptEditorMorph class>>clearEvaluator (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ clearEvaluator
+ "
+ 	ScriptEditorMorph clearEvaluator.
+ "
+ 	Evaluator _ nil.
+ !

Item was added:
+ ----- Method: ScriptEditorMorph class>>generateParseNodeDirectly: (in category '*Etoys-Squeakland-accessing') -----
+ generateParseNodeDirectly: aBoolean
+ 	"Set the value for the class variable GenerateParseNodeDirectly, which governs an option of how to compile tile scripts."
+ 
+ 	GenerateParseNodeDirectly _ aBoolean.
+ 
+ "
+ ScriptEditorMorph generateParseNodeDirectly: true
+ ScriptEditorMorph generateParseNodeDirectly: false
+ "
+ !

Item was added:
+ ----- Method: ScriptEditorMorph class>>initialize (in category 'class initialization') -----
+ initialize
+ 
+ 	Rewrite := true.
+ 	GenerateParseNodeDirectly := true.!

Item was added:
+ ----- Method: ScriptEditorMorph class>>setDefaultEvaluator (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ setDefaultEvaluator
+ 
+ 	Evaluator _ KedamaAttributeEvaluator new.
+ 	Evaluator defineSyntaxFrom: KedamaAttributeEvaluator squeakParseNodes.
+ 	Evaluator readDefinitionsFrom: KedamaTurtleMethodAttributionDefinition2.
+ 	Evaluator compileEvaluator.
+ !

Item was added:
+ ----- Method: ScriptEditorMorph class>>setRewriteFlag: (in category '*Etoys-Squeakland-Tweak-Kedama') -----
+ setRewriteFlag: aBoolean
+ 
+ 	Rewrite _ aBoolean.
+ !

Item was added:
+ ----- Method: ScriptEditorMorph class>>trackedEditor (in category '*Etoys-Squeakland-tracking') -----
+ trackedEditor
+ 
+ 	^ TrackedEditor
+ !

Item was added:
+ ----- Method: ScriptEditorMorph class>>trackedEditor: (in category '*Etoys-Squeakland-tracking') -----
+ trackedEditor: anObject
+ 
+ 	TrackedEditor _ anObject.
+ !

Item was changed:
  ----- Method: ScriptEditorMorph>>acceptDroppingMorph:event: (in category 'dropping/grabbing') -----
  acceptDroppingMorph: aMorph event: evt
  	"Allow the user to add tiles and program fragments just by dropping them on this morph."
  
  	| i slideMorph p1 p2 |
  
  	self prepareToUndoDropOf: aMorph.
  	"Find where it will go, and prepare to animate the move..."
+ 	i _ self rowInsertionIndexFor: aMorph fullBounds center.
+ 	slideMorph _ aMorph imageForm offset: 0 at 0.
+ 	p1 _ aMorph screenRectangle topLeft.
- 	i := self rowInsertionIndexFor: aMorph fullBounds center.
- 	slideMorph := aMorph imageForm offset: 0 at 0.
- 	p1 := aMorph screenRectangle topLeft.
  	aMorph delete.
+ 	self stopTracking.
- 	self stopSteppingSelector: #trackDropZones.
  	self world displayWorld.  "Clear old image prior to animation"
  
+ 	(aMorph isKindOf: PhraseTileMorph orOf: CompoundTileMorph) ifTrue:
+ 		[aMorph aboutToBeAcceptedInScriptor].
- 	(aMorph isPhraseTileMorph) ifTrue:
- 		[aMorph justGrabbedFromViewer: false].
  	aMorph tileRows do: [:tileList |
  		self insertTileRow: (Array with:
  				(tileList first rowOfRightTypeFor: owner forActor: aMorph associatedPlayer))
  			after: i.
+ 		i _ i + 1].
- 		i := i + 1].
  	self removeSpaces.
  	self enforceTileColorPolicy.
  	self layoutChanged.
  	self fullBounds. "force layout"
  
  	"Now animate the move, before next Morphic update.
  		NOTE: This probably should use ZoomMorph instead"
+ 	p2 _ (self submorphs atPin: (i-1 max: firstTileRow)) screenRectangle topLeft.
- 	p2 := (self submorphs atPin: (i-1 max: firstTileRow)) screenRectangle topLeft.
  	slideMorph slideFrom: p1 to: p2 nSteps: 5 delay: 50 andStay: true.
  	self playSoundNamed: 'scritch'.
+ 	self topEditor scriptEdited  "Keep me for editing, a copy goes into lastAcceptedScript"!
- 	self topEditor install  "Keep me for editing, a copy goes into lastAcceptedScript"!

Item was changed:
  ----- Method: ScriptEditorMorph>>actuallyDestroyScript (in category 'customevents-buttons') -----
  actuallyDestroyScript
  	"Carry out the actual destruction of the associated script."
  
  	| aHandler itsCostume |
  	self delete.
+ 	playerScripted removeScriptNamed: scriptName.
- 	playerScripted class removeScriptNamed: scriptName.
  	playerScripted actorState instantiatedUserScriptsDictionary removeKey: scriptName ifAbsent: [].
  		"not quite enough yet in the multiple-instance case..."
+ 	itsCostume _ playerScripted costume.
+ 	(aHandler _ itsCostume renderedMorph eventHandler) ifNotNil:
- 	itsCostume := playerScripted costume.
- 	(aHandler := itsCostume renderedMorph eventHandler) ifNotNil:
  		[aHandler forgetDispatchesTo: scriptName].
  	itsCostume removeActionsSatisfying: [ :act | act receiver == playerScripted and: [ act selector == scriptName ]].
  	itsCostume currentWorld removeActionsSatisfying: [ :act | act receiver == playerScripted and: [ act selector == scriptName ]].
  	playerScripted updateAllViewersAndForceToShow: ScriptingSystem nameForScriptsCategory!

Item was added:
+ ----- Method: ScriptEditorMorph>>addCommandFeedback: (in category '*Etoys-Squeakland-menu commands') -----
+ addCommandFeedback: evt
+ !

Item was changed:
  ----- Method: ScriptEditorMorph>>addCustomMenuItems:hand: (in category 'menus') -----
  addCustomMenuItems: aCustomMenu hand: aHandMorph
  	"Add custom menu items to a menu"
  
  	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
  	aCustomMenu addUpdating: #autoFitString target: self action: #autoFitOnOff.
  	aCustomMenu addLine.
  	aCustomMenu add: 'fix layout' target: self action: #fixLayout.
+ !
- 	threadPolygon ifNil: [
- 		aCustomMenu add: 'show thread' target: self action: #createThreadShowing.
- 	] ifNotNil: [
- 		aCustomMenu add: 'hide thread' target: self action: #deleteThreadShowing.
- 	].!

Item was added:
+ ----- Method: ScriptEditorMorph>>addGoldBoxItemsTo: (in category '*Etoys-Squeakland-other') -----
+ addGoldBoxItemsTo: aMenu
+ 	"Add gold-box-related submenu to the scriptor menu"
+ 
+ 	|  subMenu |
+ 
+ 	subMenu _ MenuMorph new defaultTarget: self.
+ 	subMenu addTitle: 'gold box' translated.
+ 
+ 	subMenu addTranslatedList: #(
+ 		('hand me a test-yest-no tile'			addYesNoToHand)
+ 		('hand me a "repeat..times" tile'			handUserTimesRepeatTile)
+ 		('hand me a "random number" tile'		handUserRandomTile)
+ 		('hand me a "function" tile'				handUserFunctionTile)
+ 		('hand me a "button up?" tile'				handUserButtonUpTile)
+ 		('hand me a "button down?" tile'			handUserButtonDownTile)
+ 		('hand me a tile for self	'				handUserTileForSelf)
+ 		('hand me a numeric-constant tile'		handUserNumericConstantTile)
+ 		) translatedNoop.
+ 	aMenu add: 'gold box items' translated subMenu: subMenu!

Item was changed:
  ----- Method: ScriptEditorMorph>>buttonRowForEditor (in category 'buttons') -----
  buttonRowForEditor
  	"Answer a row of buttons that comprise the header at the top of the Scriptor"
  
+ 	| aRow aString aStatusMorph aButton aTile aMorph goldBoxButton aBox |
+ 	aRow _ AlignmentMorph newRow color: ScriptingSystem baseColor; layoutInset: 1.
+ 	aRow hResizing: #spaceFill.
- 	| aRow aString buttonFont aStatusMorph aButton aColumn aTile |
- 	buttonFont := Preferences standardButtonFont.
- 	aRow := AlignmentMorph newRow color: Color transparent; layoutInset: 0.
- 	aRow hResizing: #shrinkWrap.
  	aRow vResizing: #shrinkWrap.
- 	self hasParameter ifFalse:
- 		[aRow addMorphFront:
- 			(SimpleButtonMorph new
- 				label: '!!' font: Preferences standardEToysFont;
- 				target: self;
- 				color: Color yellow;
- 				borderWidth: 0;
- 				actWhen: #whilePressed;
- 				actionSelector: #tryMe;
- 				balloonTextSelector: #tryMe).
- 		aRow addTransparentSpacerOfSize: 6 at 10].
  	self addDismissButtonTo: aRow.
+ 	aRow addTransparentSpacerOfSize: 9.
- 	aRow addTransparentSpacerOfSize: 6 at 1.
- 	aColumn := AlignmentMorph newColumn beTransparent.
- 	aColumn addTransparentSpacerOfSize: 0 at 4.
- 	aButton := UpdatingThreePhaseButtonMorph checkBox.
- 	aButton
- 		target: self;
- 		actionSelector: #toggleWhetherShowingTiles;
- 		getSelector: #showingMethodPane.
- 	aButton setBalloonText: 'toggle between showing tiles and showing textual code' translated.
- 	aColumn addMorphBack: aButton.
- 	aRow addMorphBack: aColumn.
  
+ 	"Player's name"
+ 	aString _ playerScripted externalName.
+ 	aMorph _ StringMorph contents: aString font: ScriptingSystem fontForTiles.
+ 	aMorph setNameTo: 'title'.
+ 	aRow addMorphBack: aMorph.
+ 	aRow addTransparentSpacerOfSize: 6.
- 	aRow addTransparentSpacerOfSize: 6 at 10.
  
+ 	"Script's name"
+ 	aBox := AlignmentMorph newRow.
+ 	aBox hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ 	aBox color: (Color r: 0.839 g: 1.0 b: 0.806).
+ 	aBox borderWidth: 1.
+ 	aBox  borderColor: (Color r: 0.645 g: 0.774 b: 0.613).
+ 	aButton _ UpdatingStringMorph new.
- 	aString := playerScripted externalName.
- 	aRow addMorphBack:
- 		(aButton := SimpleButtonMorph new useSquareCorners label: aString font: buttonFont; target: self; setNameTo: 'title').
- 	aButton actWhen: #buttonDown; actionSelector: #offerScriptorMenu.
- 	aButton
- 		on: #mouseEnter send: #menuButtonMouseEnter: to: aButton;
- 		on: #mouseLeave send: #menuButtonMouseLeave: to: aButton.
- 
- 	aButton borderColor: (Color fromRgbTriplet: #(0.065 0.258 1.0)).
- 	aButton color: ScriptingSystem uniformTileInteriorColor.
- 	aButton balloonTextSelector: #offerScriptorMenu.
- 	aRow addTransparentSpacerOfSize: 4 at 1.
- 	aButton := (Preferences universalTiles ifTrue: [SyntaxUpdatingStringMorph] 
- 					ifFalse: [UpdatingStringMorph]) new.
  	aButton useStringFormat;
  		target:  self;
  		getSelector: #scriptTitle;
  		setNameTo: 'script name';
  		font: ScriptingSystem fontForNameEditingInScriptor;
  		putSelector: #setScriptNameTo:;
  		setProperty: #okToTextEdit toValue: true;
+ 		step;
+ 		yourself.
+ 	aBox addMorph: aButton.
+ 	aRow addMorphBack: aBox.
+ 	aBox setBalloonText: 'Click here to edit the name of the script.' translated.
+ 	"aRow addTransparentSpacerOfSize: 9."
+ 	aRow addVariableTransparentSpacer.
+ 
+ 	"Try It button"
+ 	self hasParameter ifFalse:
+ 		[aRow addMorphBack:
+ 			((ThreePhaseButtonMorph
+ 				labelSymbol: #TryIt
+ 				target: self
+ 				actionSelector: #tryMe
+ 				arguments: #())
+ 				actWhen: #whilePressed;
+ 				balloonTextSelector: #tryMe).
+ 		aRow addTransparentSpacerOfSize: 3].
+ 
+ 	"Step button"
+ 	self hasParameter ifFalse:
+ 		[aRow addMorphBack: (aButton := ThreePhaseButtonMorph
+ 				labelSymbol: #StepMe
+ 				target: self
+ 				actionSelector: #stepMe
+ 				arguments: #()).
+ 		aButton balloonTextSelector: #stepMe.
+ 		aRow addTransparentSpacerOfSize: 3].
+ 
+ 	"Status controller"
- 		step.
- 	aRow addMorphBack: aButton.
- 	aButton setBalloonText: 'Click here to edit the name of the script.' translated.
- 	aRow addTransparentSpacerOfSize: 6 at 0.
  	self hasParameter
  		ifTrue:
+ 			[aTile _ TypeListTile new choices: Vocabulary typeChoicesForUserVariables dataType: nil.
- 			[aTile := TypeListTile new choices: Vocabulary typeChoices dataType: nil.
  			aTile addArrows.
+ 			aTile setLiteral: self typeForParameter.
- 			aTile setLiteral: #Number.
- 	"(aButton := SimpleButtonMorph new useSquareCorners label: 'parameter' translated font: buttonFont; target: self; setNameTo: 'parameter').
- 			aButton actWhen: #buttonDown; actionSelector: #handUserParameterTile.
- 
- "
  			aRow addMorphBack: aTile.
  			aTile borderColor: Color red.
  			aTile color: ScriptingSystem uniformTileInteriorColor.
+ 			aTile setBalloonText: 'Drag from here to get a parameter tile' translated.
+ 			aTile addCaretsAsAppropriate: true]
- 			aTile setBalloonText: 'Drag from here to get a parameter tile' translated]
  		ifFalse:
+ 			[aRow addMorphBack: (aStatusMorph _ self scriptInstantiation statusControlMorph)].
- 			[aRow addMorphBack: (aStatusMorph := self scriptInstantiation statusControlMorph)].
  
+ 	"aRow addTransparentSpacerOfSize: 3."
+ 	aRow addVariableTransparentSpacer.
- 	aRow addTransparentSpacerOfSize: 6 at 1.
  
+ 	"Gold-box"
+ 	aRow addMorphBack: (goldBoxButton _ IconicButton new).
+ 	goldBoxButton borderWidth: 0;
+ 			labelGraphic: (ScriptingSystem formAtKey: 'RoundGoldBox'); color: Color transparent; 
- 	aRow addMorphBack:
- 		(IconicButton new borderWidth: 0;
- 			labelGraphic: (ScriptingSystem formAtKey: 'AddTest'); color: Color transparent; 
  			actWhen: #buttonDown;
  			target: self;
+ 			actionSelector: #offerGoldBoxMenu;
- 			actionSelector: #addYesNoToHand;
  			shedSelvedge;
+ 			setBalloonText: 'click here to get a palette of useful tiles to use in your script.' translated.
+ 	aRow addTransparentSpacerOfSize: 6 at 1.
+ 
+ 	"Menu Button"
+ 	aButton _ self menuButton.
+ 	aButton actionSelector: #offerScriptorMenu.
+ 	aRow addMorphBack: aButton.
+ 
- 			balloonTextSelector: #addYesNoToHand).
- 	aRow addTransparentSpacerOfSize: 12 at 10.
- 	self addDestroyButtonTo: aRow.
  	(playerScripted existingScriptInstantiationForSelector: scriptName)
+ 		ifNotNilDo:
- 		ifNotNil:
  			[:inst | inst updateStatusMorph: aStatusMorph].
  	^ aRow!

Item was added:
+ ----- Method: ScriptEditorMorph>>buttonToOpenOrCloseThisScript (in category '*Etoys-Squeakland-customevents-other') -----
+ buttonToOpenOrCloseThisScript
+ 	"Hand the user a button which, when clicked, will show or hide this scriptor"
+ 
+ 	| aButton |
+ 	aButton := ScriptOpeningButtonMorph new.
+ 	aButton affiliatedScriptor: self.
+ 	aButton label: aButton standardLabelForButton.
+ 	aButton color:  (Color r: 0.677 g: 0.935 b: 0.484).
+ 	aButton target: self; actionSelector: #openOrCloseScriptor.
+ 	aButton setBalloonText: ('show or hide the script named {1} ' translated format: {scriptName}).
+ 	aButton openInHand!

Item was added:
+ ----- Method: ScriptEditorMorph>>deleteEtoysDebugger (in category '*Etoys-Squeakland-etoys-debugger') -----
+ deleteEtoysDebugger
+ 	"If present, delete the currently-associated etoysDebugger."
+ 
+ 	| aDebugger |
+ 	aDebugger := self valueOfProperty: #etoysDebugger ifAbsent: [^ self].
+ 	aDebugger delete.  "removes the highlighter from the world"
+ 	self removeProperty: #etoysDebugger!

Item was changed:
  ----- Method: ScriptEditorMorph>>destroyScript (in category 'buttons') -----
  destroyScript
  	"At user request, and only after confirmation, destroy the script, thus removing it from the uniclass's method dictionary and removing its instantiations from all instances of uniclass, etc."
  
  	(self confirm: 'Caution -- this destroys this script
  permanently; are you sure you want to do this?' translated) ifFalse: [^ self].
  	true ifTrue: [^ playerScripted removeScript: scriptName fromWorld: self world].
  
  	self flag: #deferred.  "revisit"
  	(playerScripted okayToDestroyScriptNamed: scriptName)
  		ifFalse:
  			[^ self inform: 'Sorry, this script is being called
  from another script.' translated].
  
+ 	Cursor wait showWhile: [
+ 		self actuallyDestroyScript].!
- 	self actuallyDestroyScript!

Item was changed:
  ----- Method: ScriptEditorMorph>>dismiss (in category 'buttons') -----
  dismiss
+ 	"Dismiss the scriptor, usually nondestructively.  Possibly animate the dismissal."
- 	"Dismiss the scriptor, usually nondestructively"
  
+ 	| endPoint aForm startPoint topRend |
  	owner ifNil: [^ self].
  	scriptName ifNil: [^ self delete].  "ad hoc fixup for bkwrd compat"
+ 
+ 	endPoint := self viewerTile ifNotNilDo: [:tile | tile topLeft] ifNil: [owner topRight].
+ 	aForm := (topRend := self topRendererOrSelf) imageForm  offset: (0 at 0).
+ 	handWithTile _ nil.
+ 	startPoint := topRend topLeft.
+ 	topRend topRendererOrSelf delete.
+ 	(playerScripted isExpendableScript: scriptName) ifTrue: [^ playerScripted removeScript: scriptName  fromWorld: ActiveWorld].
+ 
+ 	ActiveWorld displayWorld.
+ 	aForm slideFrom: startPoint to: endPoint nSteps: 4 delay: 30.
+ 	"The OLPC Virtual Screen wouldn't notice the last update here."
+ 	Display forceToScreen: (endPoint extent: aForm extent).
+ !
- 	(playerScripted isExpendableScript: scriptName) ifTrue: [playerScripted removeScript: scriptName  fromWorld: self world].
- 	handWithTile := nil.
- 	self delete!

Item was added:
+ ----- Method: ScriptEditorMorph>>enforceImplicitSelf (in category '*Etoys-Squeakland-access') -----
+ enforceImplicitSelf
+ 	"If the implicitSelf preference is set to true, obscure all unnecessary objRef tiles."
+ 
+ 	self scriptContainer allMorphs do:
+ 		[:m | ((m isKindOf: TileMorph) and: [m type == #objRef])
+ 			ifTrue:
+ 				[m emblazonPlayerNameOnReferenceTileWithin: self]] !

Item was added:
+ ----- Method: ScriptEditorMorph>>etoysDebugger (in category '*Etoys-Squeakland-etoys-debugger') -----
+ etoysDebugger
+ 	^ self valueOfProperty: #etoysDebugger ifAbsentPut: [EtoysDebugger on: self]!

Item was changed:
  ----- Method: ScriptEditorMorph>>explainStatusAlternatives (in category 'customevents-other') -----
  explainStatusAlternatives
+ 	"Explain the scripting-status alternatives."
+ 
+ 		ScriptingSystem putUpInfoPanelFor:(ScriptingSystem statusHelpStringFor: playerScripted) title: 'Script Status' translated extent: 800 at 500!
- 	(StringHolder new contents: (ScriptingSystem statusHelpStringFor: playerScripted))
- 		openLabel: 'Script Status' translated!

Item was added:
+ ----- Method: ScriptEditorMorph>>findObject (in category '*Etoys-Squeakland-menu commands') -----
+ findObject
+ 	"Reveal the object bearing the code "
+ 
+ 	playerScripted revealPlayerIn: ActiveWorld!

Item was added:
+ ----- Method: ScriptEditorMorph>>generateParseNodeDirectly (in category '*Etoys-Squeakland-access') -----
+ generateParseNodeDirectly
+ 
+ 	^ GenerateParseNodeDirectly == true.
+ !

Item was added:
+ ----- Method: ScriptEditorMorph>>goldBoxMenu (in category '*Etoys-Squeakland-gold box') -----
+ goldBoxMenu
+ 	"Answer a graphical menu to be put up in conjunction with the Gold Box"
+ 	
+ 	| aBox |
+ 	aBox _ ActiveWorld findA:  GoldBoxMenu.
+ 	aBox ifNil: [aBox _ GoldBoxMenu new].
+ 	aBox initializeFor: self.
+ 	^ aBox!

Item was added:
+ ----- Method: ScriptEditorMorph>>handUserFunctionTile (in category '*Etoys-Squeakland-other') -----
+ handUserFunctionTile
+ 	"Hand the user a function tile, presumably to drop in the script"
+ 
+ 	| functionPhrase argTile aPad |
+ 	functionPhrase _ FunctionTile new.
+ 	argTile := (Vocabulary vocabularyNamed: 'Number') defaultArgumentTile.
+ 	aPad := TilePadMorph new setType: #Number.
+ 	aPad addMorphBack: argTile.
+ 	functionPhrase operator: #abs pad: aPad.
+ 	functionPhrase openInHand!

Item was added:
+ ----- Method: ScriptEditorMorph>>handUserNumericConstantTile (in category '*Etoys-Squeakland-initialize buttons') -----
+ handUserNumericConstantTile
+ 	"Construct a numeric-constant tile and hand it to the user."
+ 
+ 	| aTile |
+ 	aTile := Vocabulary numberVocabulary defaultArgumentTile.
+ 	aTile openInHand!

Item was changed:
  ----- Method: ScriptEditorMorph>>handUserRandomTile (in category 'other') -----
  handUserRandomTile
  	"Hand the user a random-number tile, presumably to drop in the script"
  
+ 	| functionPhrase argTile aPad |
+ 	functionPhrase _ FunctionTile new.
+ 	argTile := (Vocabulary vocabularyNamed: 'Number') defaultArgumentTile.
+ 	aPad := TilePadMorph new setType: #Number.
+ 	aPad addMorphBack: argTile.
+ 	functionPhrase operator: #random pad: aPad.
+ 	functionPhrase openInHand!
- 	self currentHand attachMorph: RandomNumberTile new markAsPartsDonor makeAllTilesGreen
- 
- 	!

Item was added:
+ ----- Method: ScriptEditorMorph>>handUserTimesRepeatTile (in category '*Etoys-Squeakland-other') -----
+ handUserTimesRepeatTile
+ 	"Hand the user a times-repeat tile, presumably to drop in the script"
+ 	
+ 	| aMorph |
+ 	aMorph := TimesRepeatTile new.
+ 	ActiveHand attachMorph: aMorph.
+ 	aMorph position: ActiveHand position
+ 		!

Item was added:
+ ----- Method: ScriptEditorMorph>>hasKedamaTurtlePlayer (in category '*Etoys-Squeakland-other') -----
+ hasKedamaTurtlePlayer
+ 
+ 	self tileRows do: [:row |
+ 		row do: [:phrase | phrase traverseSearchForKedamaTurtleIfFound: [^ true]].
+ 	].
+ 	^ false.
+ !

Item was changed:
  ----- Method: ScriptEditorMorph>>initialize (in category 'initialization') -----
  initialize
  	"initialize the state of the receiver"
  	super initialize.
  	""
  	self listDirection: #topToBottom;
  		 hResizing: #shrinkWrap;
  		 vResizing: #shrinkWrap;
  		 cellPositioning: #topLeft;
  		 setProperty: #autoFitContents toValue: true;
+ 	 layoutInset: 2.
+ 	self useRoundedCornersInEtoys.
+ 	self borderColor: ScriptingSystem borderColor.
- 	 layoutInset: 2;
- 	 useRoundedCorners.
  	self setNameTo: 'Script Editor' translated.
+ 	firstTileRow _ 1.
- 	firstTileRow := 1.
  	"index of first tile-carrying submorph"
  	self addNewRow.
+ 	showingMethodPane _ false.
+ !
- 	showingMethodPane := false!

Item was changed:
  ----- Method: ScriptEditorMorph>>insertTileRow:after: (in category 'private') -----
  insertTileRow: tileList after: index
  	"Return a row to be used to insert an entire row of tiles."
  
  	| row |
+ 	row _ AlignmentMorph newRow
- 	row := AlignmentMorph newRow
  		vResizing: #spaceFill;
  		layoutInset: 0;
  		extent: (bounds width)@(TileMorph defaultH);
  		color: Color transparent.
+ 	row position: self position.
  	row addAllMorphs: tileList.
+ 	tileList do: [:t | t justAddedAsTileRow].
  	self privateAddMorph: row atIndex: index + 1.
  !

Item was changed:
  ----- Method: ScriptEditorMorph>>install (in category 'buttons') -----
  install
  	"Accept the current classic tiles as the new source code for the script.  In the case of universalTiles, initialize the method and its methodInterface if not already done."
  
  	Preferences universalTiles ifFalse:
  		[self removeSpaces].
  	scriptName ifNotNil:
+ 		[playerScripted acceptScript: self topEditor for:  scriptName asSymbol].
+ 
+ 	self enforceImplicitSelf!
- 		[playerScripted acceptScript: self topEditor for:  scriptName asSymbol]!

Item was changed:
  ----- Method: ScriptEditorMorph>>isTextuallyCoded (in category 'other') -----
  isTextuallyCoded
  	(self topEditor isKindOf: ScriptEditorMorph) ifFalse: [^ false].  "workaround for the case where the receiver is embedded in a free-standing CompoundTileMorph.  Yecch!!"
+ 	^ self userScriptObject notNil and: [self userScriptObject isTextuallyCoded]!
- 	^ self userScriptObject isTextuallyCoded!

Item was changed:
  ----- Method: ScriptEditorMorph>>localeChanged (in category 'e-toy support') -----
  localeChanged
  	"Update myself to reflect the change in locale"
  
+ 	self fixLayout.
+ 	self == self topEditor ifTrue:  "nested script-editors handled by the topmost."
+ 		[self fixUpCarets]!
- 	self fixLayout!

Item was added:
+ ----- Method: ScriptEditorMorph>>methodNode (in category '*Etoys-Squeakland-customevents-buttons') -----
+ methodNode
+ 	"Answer the source-code string for the receiver.  This is for use by classic tiles, but is also used in universal tiles to formulate an initial method declaration for a nascent user-defined script; in universalTiles mode, the codeString (at present anyway) is empty -- the actual code derives from the SyntaxMorph in that case"
+ 
+ 	| evaluator rewriter node |
+ 	(submorphs size = 2 and: [(submorphs second isMemberOf: MethodMorph)]) ifTrue: [
+ 		^ playerScripted class compilerClass new
+ 				compile: submorphs second model contents
+ 				in: playerScripted class
+ 				notifying: nil
+ 				ifFail: [] for: playerScripted.
+ 	].
+ 	node _ self scriptParseNodeIn: self referenceWorld.
+ 	self hasKedamaTurtlePlayer ifFalse: [^ node].
+ 	Evaluator ifNil: [
+ 		self class setDefaultEvaluator.
+ 	].
+ 	evaluator _ Evaluator.
+ 	evaluator makeAttributedTreeWith: node forReceiver: playerScripted.
+ 	evaluator addGraphEdgesRoot.
+ 	evaluator evaluateAllOccurence.
+ 
+ 	Rewrite ifTrue: [
+ 		rewriter _ KedamaVectorParseTreeRewriter new.
+ 		rewriter attributedTree: evaluator attributedTree.
+ 		rewriter parseTree: evaluator attributedTree tree.
+ 		rewriter setEncoderFor: playerScripted in: self referenceWorld.
+ 		rewriter visit: evaluator attributedTree tree andParent: nil.
+ 		^ playerScripted class compilerClass new compile: rewriter parseTree decompileString in: playerScripted class notifying: nil ifFail: [^nil] for: playerScripted.
+ 	] ifFalse: [
+ 		evaluator attributedTree inspect.
+ 		^ evaluator parseTree
+ 	].
+ !

Item was changed:
  ----- Method: ScriptEditorMorph>>methodString (in category 'other') -----
  methodString
  	"Answer the source-code string for the receiver.  This is for use by classic tiles, but is also used in universal tiles to formulate an initial method declaration for a nascent user-defined script; in universalTiles mode, the codeString (at present anyway) is empty -- the actual code derives from the SyntaxMorph in that case"
  
+ 	| string evaluator rewriter |
+ 	(submorphs size = 2 and: [(submorphs second isMemberOf: MethodMorph)]) ifTrue: [
+ 		^ submorphs second model contents
+ 	].
+ 	string _ String streamContents:
- 	| k methodNode string |
- 	playerScripted class compileSilently: (string := String streamContents:
  		[:aStream |
  			aStream nextPutAll: scriptName.
  			scriptName endsWithAColon ifTrue:
  				[aStream nextPutAll: ' parameter'].
  			aStream cr; cr; tab.
  			aStream nextPutAll: self codeString.
+ 	].
+ 	self hasKedamaTurtlePlayer ifFalse: [^ string].
+ 	Evaluator ifNil: [
+ 		self class setDefaultEvaluator.
+ 	].
+ 	evaluator _ Evaluator.
+ 	playerScripted class compileSilently: string classified: 'temporary'.
+ 	evaluator makeAttributedTreeWith: ((playerScripted class compiledMethodAt: scriptName) decompileClass: playerScripted class selector: scriptName) forReceiver: playerScripted.
+ 	evaluator addGraphEdgesRoot.
+ 	evaluator evaluateAllOccurence.
- 	]) classified: 'temporary'.
  
+ 	Rewrite ifTrue: [
+ 		rewriter _ KedamaVectorParseTreeRewriter new.
+ 		rewriter attributedTree: evaluator attributedTree.
+ 		rewriter parseTree: evaluator attributedTree tree.
+ 		rewriter setEncoderFor: playerScripted in: self referenceWorld.
+ 		rewriter visit: evaluator attributedTree tree andParent: nil.
+ 		^ rewriter parseTree printString.
+ 	] ifFalse: [
+ 		evaluator attributedTree inspect.
+ 		^ string
+ 	].
- 	k := KedamaVectorizer new initialize.
- 	(k includesTurtlePlayer: (playerScripted class decompile: scriptName) for: playerScripted) ifFalse: [^ string].
- 
- 	methodNode := k vectorize: (playerScripted class decompile: scriptName) 	object: playerScripted.
- 	^ methodNode decompileString.
  !

Item was changed:
  ----- Method: ScriptEditorMorph>>mouseEnter: (in category 'event handling') -----
  mouseEnter: evt
  	| hand tile |
  
+ 	hand _ evt hand.
- 	self flag: #bob.		"needed renderedMorph due to transformations"
- 	hand := evt hand.
  	hand submorphs size = 1 ifFalse: [^self].
+ 	tile _ hand firstSubmorph renderedMorph.
+ 	"self class = BooleanScriptEditor ifTrue: [self halt]."
- 	tile := hand firstSubmorph renderedMorph.
  	(self wantsDroppedMorph: tile event: evt) ifFalse: [^self].
+ 	handWithTile _ hand.
+ 	self startTracking.
+ !
- 	handWithTile := hand.
- 	self startSteppingSelector: #trackDropZones.!

Item was changed:
  ----- Method: ScriptEditorMorph>>mouseLeave: (in category 'event handling') -----
  mouseLeave: evt
  	owner ifNil: [^ self].	"left by being removed, not by mouse movement"
  	(self hasProperty: #justPickedUpPhrase) ifTrue:[
  		self removeProperty: #justPickedUpPhrase.
  		^self].
+ 	self stopTracking.
- 	self stopSteppingSelector: #trackDropZones.
- 	handWithTile := nil.
  	self removeSpaces.!

Item was added:
+ ----- Method: ScriptEditorMorph>>nextTile (in category '*Etoys-Squeakland-etoys-debugger') -----
+ nextTile
+ 	^ (self ownerThatIsA: TileLikeMorph orA: ScriptEditorMorph)
+ 		nextTile
+ !

Item was added:
+ ----- Method: ScriptEditorMorph>>nextTileTo: (in category '*Etoys-Squeakland-etoys-debugger') -----
+ nextTileTo: aTileMorph 
+ 	| tiles index |
+ 	tiles := self tiles.
+ 	index := (tiles indexOf: aTileMorph) + 1.
+ 	index > tiles size
+ 		ifTrue: [self = self topEditor
+ 			ifTrue: [^ tiles at: 1]
+ 			ifFalse: [^ self nextTile]].
+ 	^ tiles at: index!

Item was added:
+ ----- Method: ScriptEditorMorph>>offerGoldBoxMenu (in category '*Etoys-Squeakland-gold box') -----
+ offerGoldBoxMenu 
+ 	"Put up a gold-box menu beneath my gold-box icon.  This will re-use an existing one"
+ 
+ 	self goldBoxMenu openInWorld; goHome!

Item was changed:
  ----- Method: ScriptEditorMorph>>offerScriptorMenu (in category 'other') -----
  offerScriptorMenu
  	"Put up a menu in response to the user's clicking in the menu-request area of the scriptor's heaer"
  
+ 	| aMenu count |
- 	| aMenu  count |
  
  	self modernize.
  	ActiveHand showTemporaryCursor: nil.
  
+ 	Preferences eToyFriendly ifTrue: [^ self offerSimplerScriptorMenu].
+ 
+ 	aMenu _ MenuMorph new defaultTarget: self.
- 	aMenu := MenuMorph new defaultTarget: self.
  	aMenu addTitle: scriptName asString.
+ 	aMenu addStayUpItem.  "NB:  the kids version in #offerSimplerScriptorMenu does not deploy the stay-up item"
  
+ 	aMenu addList: (self hasParameter
+ 		ifTrue: [{
+ 			{'remove parameter' translated.					#ceaseHavingAParameter}}]
+ 		ifFalse: [{
+ 			{'add parameter' translated.						#addParameter}}]).
+ 
+ 	self hasParameter ifFalse:
+ 		[aMenu addTranslatedList: {
+ 			{'button to fire this script' translatedNoop. #tearOfButtonToFireScript}.
+ 			{'fires per tick...' translatedNoop. #chooseFrequency}.
+ 			#-
+ 		}].
+ 
+ 	aMenu addUpdating: #showingCaretsString  target: self action: #toggleShowingCarets.
+ 	aMenu addLine.
+ 	aMenu addList: {
+ 		{'edit balloon help for this script' translated.		#editMethodDescription}.
+ 		{'explain status alternatives' translated. 			#explainStatusAlternatives}.
+ 		{'button to show/hide this script' translated.			#buttonToOpenOrCloseThisScript}.
+ 		#-
+ 	}.
+ 
+ 
  	Preferences universalTiles ifFalse:
+ 		[count _ self savedTileVersionsCount.
- 		[count := self savedTileVersionsCount.
  		self showingMethodPane
  			ifFalse:				"currently showing tiles"
+ 				[aMenu add: 'show code textually' translated action: #toggleWhetherShowingTiles.
- 				[aMenu add: 'show code textually' translated action: #showSourceInScriptor.
  				count > 0 ifTrue: 
  					[aMenu add: 'revert to tile version...' translated action:	 #revertScriptVersion].
  				aMenu add: 'save this version' translated	action: #saveScriptVersion]
  
  			ifTrue:				"current showing textual source"
  				[count >= 1 ifTrue:
+ 					[aMenu add: 'revert to tile version' translated action: #toggleWhetherShowingTiles]]].
- 					[aMenu add: 'revert to tile version' translated action: #revertToTileVersion]]].
  
+ 	"aMenu addLine.
+ 	self addGoldBoxItemsTo: aMenu."
- 	aMenu addList: {
- 		#-.
- 		{'destroy this script' translated.					#destroyScript}.
- 		{'rename this script' translated.					#renameScript}.
- 		}.
  
+ 	aMenu addLine.
+ 	
+ 	aMenu add: 'grab this object' translated target: playerScripted selector: #grabPlayerIn: argument: ActiveWorld.
+ 	aMenu balloonTextForLastItem: 'This will actually pick up the object bearing this script and hand it to you.  Click the (left) button to drop it' translated.
- 	self hasParameter ifFalse:
- 		[aMenu addList: {{'button to fire this script' translated.			#tearOfButtonToFireScript}}].
  
+ 	aMenu add: 'reveal this object' translated target: playerScripted selector: #revealPlayerIn: argument: ActiveWorld.
+ 	aMenu balloonTextForLastItem: 'If you have misplaced the object bearing this script, use this item to (try to) make it visible' translated.
+ 
+ 	aMenu add: 'tile representing this object' translated target: playerScripted action: #tearOffTileForSelf.
+ 	aMenu balloonTextForLastItem: 'choose this to obtain a tile which represents the object associated with this script' translated.
+ 
+ 	aMenu addTranslatedList: {
- 	aMenu addList: {
- 		{'edit balloon help for this script' translated.		#editMethodDescription}.
  		#-.
+ 		{'open viewer' translatedNoop. #openObjectsViewer.  'open the viewer of the object to which this script belongs' translatedNoop}.
+ 		{'detached method pane' translatedNoop. #makeIsolatedCodePane. 'open a little window that shows the Smalltalk code underlying this script.' translatedNoop}.
- 		{'explain status alternatives' translated. 			#explainStatusAlternatives}.
  		#-.
+ 		{'destroy this script' translatedNoop. #destroyScript}
+ 	}.
- 		{'hand me a tile for self' translated.					#handUserTileForSelf}.
- 		{'hand me a "random number" tile' translated.		#handUserRandomTile}.
- 		{'hand me a "button down?" tile' translated.		#handUserButtonDownTile}.
- 		{'hand me a "button up?" tile' translated.			#handUserButtonUpTile}.
- 		}.
  
- 	aMenu addList: (self hasParameter
- 		ifTrue: [{
- 			#-.
- 			{'remove parameter' translated.					#ceaseHavingAParameter}}]
- 		ifFalse: [{
- 			{'fires per tick...' translated.						#chooseFrequency}.
- 			#-.
- 			{'add parameter' translated.						#addParameter}}]).
  
  	aMenu popUpInWorld: self currentWorld.
  !

Item was added:
+ ----- Method: ScriptEditorMorph>>offerSimplerScriptorMenu (in category '*Etoys-Squeakland-other') -----
+ offerSimplerScriptorMenu
+ 	"Put up a menu in response to the user's clicking in the menu-request area of the scriptor's heaer.  This variant is used when eToyFriendly preference is true."
+ 
+ 	| aMenu count |
+ 
+ 	ActiveHand showTemporaryCursor: nil.
+ 
+ 	aMenu _ MenuMorph new defaultTarget: self.
+ 	aMenu addTitle: scriptName asString.
+ 
+ 	aMenu addList: (self hasParameter
+ 		ifTrue: [{
+ 			{'remove parameter' translated.					#ceaseHavingAParameter}}]
+ 		ifFalse: [{
+ 			{'add parameter' translated.						#addParameter}}]).
+ 
+ 	self hasParameter ifFalse:
+ 		[aMenu addTranslatedList: #(
+ 			('button to fire this script' tearOfButtonToFireScript)
+ 			-) translatedNoop].
+ 
+ 	aMenu addUpdating: #showingCaretsString  target: self action: #toggleShowingCarets.
+ 	aMenu addLine.
+ 	aMenu addList: {
+ 		{'edit balloon help for this script' translated.		#editMethodDescription}.
+ 		{'explain status alternatives' translated. 			#explainStatusAlternatives}.
+ 		{'button to show/hide this script' translated.			#buttonToOpenOrCloseThisScript}.
+ 		#-
+ 	}.
+ 
+ 
+ 	Preferences universalTiles ifFalse:
+ 		[count _ self savedTileVersionsCount.
+ 		self showingMethodPane
+ 			ifFalse:				"currently showing tiles"
+ 				[aMenu add: 'show code textually' translated action: #toggleWhetherShowingTiles.
+ 				count > 0 ifTrue: 
+ 					[aMenu add: 'revert to tile version...' translated action:	 #revertScriptVersion].
+ 				aMenu add: 'save this version' translated	action: #saveScriptVersion]
+ 
+ 			ifTrue:				"current showing textual source"
+ 				[count >= 1 ifTrue:
+ 					[aMenu add: 'revert to tile version' translated action: #toggleWhetherShowingTiles]]].
+ 
+ 	aMenu addLine.
+ 	
+ 	aMenu add: 'grab this object' translated target: playerScripted selector: #grabPlayerIn: argument: ActiveWorld.
+ 	aMenu balloonTextForLastItem: 'This will actually pick up the object bearing this script and hand it to you.  Click the (left) button to drop it' translated.
+ 
+ 	aMenu add: 'reveal this object' translated target: playerScripted selector: #revealPlayerIn: argument: ActiveWorld.
+ 	aMenu balloonTextForLastItem: 'If you have misplaced the object bearing this script, use this item to (try to) make it visible' translated.
+ 
+ 	aMenu add: 'tile representing this object' translated target: playerScripted action: #tearOffTileForSelf.
+ 	aMenu balloonTextForLastItem: 'choose this to obtain a tile which represents the object associated with this script' translated.
+ 
+ 	aMenu addLine.
+ 
+ 	aMenu addTranslatedList: #(
+ 		-
+ 		('open viewer'		openObjectsViewer  'open the viewer of the object to which this script belongs')
+ 		-
+ 		('destroy this script' destroyScript)) translatedNoop.
+ 
+ 
+ 	aMenu popUpInWorld: self currentWorld.
+ !

Item was added:
+ ----- Method: ScriptEditorMorph>>openObjectsViewer (in category '*Etoys-Squeakland-menu commands') -----
+ openObjectsViewer
+ 	"Open the viewer of the player whose code I bear."
+ 
+ 	| aMorph |
+ 	aMorph := playerScripted costume.
+ 	aMorph presenter viewMorph: aMorph!

Item was added:
+ ----- Method: ScriptEditorMorph>>openOrCloseScriptor (in category '*Etoys-Squeakland-customevents-other') -----
+ openOrCloseScriptor
+ 	"Open up the scriptor on the screen"
+ 
+ 	self isInWorld
+ 		ifTrue:
+ 			[self delete]
+ 		ifFalse:
+ 			[self openInWorld; goHome; comeToFront]!

Item was added:
+ ----- Method: ScriptEditorMorph>>parseNodeWith: (in category '*Etoys-Squeakland-other') -----
+ parseNodeWith: encoder
+ 
+ 	| statements ret |
+ 	statements _ WriteStream on: (Array new: self tileRows size).
+ 	self tileRows do: [:r | 
+ 		r do: [:m | 
+ 			((m isKindOf: TileMorph) 
+ 				or: [(m isKindOf: CompoundTileMorph)
+ 					or: [m isKindOf: PhraseTileMorph]]) ifTrue: [
+ 						statements nextPut: (m parseNodeWith: encoder asStatement: true)]]].
+ 	statements _ statements contents.
+ 	ret _ ReturnNode new expr: (encoder encodeVariable: 'self').
+ 	^ BlockNode new arguments: #() statements: (statements copyWith: ret) returns: true from: encoder.
+ !

Item was changed:
  ----- Method: ScriptEditorMorph>>phrase: (in category 'initialization') -----
  phrase: aPhraseTileMorph
  	"Make the receiver be a Scriptor for a new script whose initial contents is the given phrase."
  
  	| aHolder |
+ 	firstTileRow _ 2.
+ 	aHolder _ AlignmentMorph newRow.
- 	firstTileRow := 2.
- 	aHolder := AlignmentMorph newRow.
  	aHolder beTransparent; layoutInset: 0.
  	aHolder addMorphBack: aPhraseTileMorph.
  	self addMorphBack: aHolder.
+ 	self scriptEdited!
- 	self install!

Item was added:
+ ----- Method: ScriptEditorMorph>>removeDropSpaces (in category '*Etoys-Squeakland-dropping/grabbing') -----
+ removeDropSpaces
+ 
+ 	dropSpaces ifNotNil: [dropSpaces do: [:m | m delete]].
+ !

Item was changed:
  ----- Method: ScriptEditorMorph>>removeSpaces (in category 'dropping/grabbing') -----
  removeSpaces
  	"Remove vertical space"
+ 	dropSpaces ifNotNil: [dropSpaces do: [:m | m delete]].
+ 	dropSpaces _ nil.
- 
- 	self submorphsDo:
- 		[:m | (m isMemberOf: Morph) ifTrue: [m delete]].
  	self removeEmptyRows.
+ 	submorphs isEmpty ifTrue: [self height: self minHeight].
+ !
- 	submorphs isEmpty ifTrue: [self height: 14]!

Item was changed:
  ----- Method: ScriptEditorMorph>>renameScriptTo: (in category 'other') -----
  renameScriptTo: newSelector
  	"Rename the receiver's script so that it bears a new selector"
  
  	| aMethodNodeMorph methodMorph methodSource pos newMethodSource |
  
+ 	scriptName _ newSelector.
- 	scriptName := newSelector.
  	self updateHeader.
  	Preferences universalTiles
  		ifFalse:  "classic tiles"
  			[self showingMethodPane
  				ifTrue:
  					["textually coded -- need to change selector"
+ 					methodMorph _ self findA: MethodMorph.
+ 					methodSource _ methodMorph text string.
+ 					pos _ methodSource indexOf: Character cr ifAbsent: [self error: 'no cr'].
+ 					newMethodSource _ newSelector.
+ 					newSelector numArgs > 0 ifTrue: [newMethodSource _ newMethodSource, ' t1'].  "for the parameter"
+ 					newMethodSource _ newMethodSource, (methodSource copyFrom: pos to: methodSource size).
- 					methodMorph := self findA: MethodMorph.
- 					methodSource := methodMorph text string.
- 					pos := methodSource indexOf: Character cr ifAbsent: [self error: 'no cr'].
- 					newMethodSource := newSelector.
- 					newSelector numArgs > 0 ifTrue: [newMethodSource := newMethodSource, ' t1'].  "for the parameter"
- 					newMethodSource := newMethodSource, (methodSource copyFrom: pos to: methodSource size).
  					methodMorph editString: newMethodSource.
  					methodMorph model changeMethodSelectorTo: newSelector.
+ 					playerScripted class compileSilently: newMethodSource classified: 'scripts'.
- 					playerScripted class compile: newMethodSource classified: 'scripts'.
  					methodMorph accept]
  				ifFalse:
  					[self install]]
  		ifTrue:  "universal tiles..."
+ 			[(aMethodNodeMorph _ self methodNodeMorph) ifNotNil:
- 			[(aMethodNodeMorph := self methodNodeMorph) ifNotNil:
  				[aMethodNodeMorph acceptInCategory: 'scripts']]!

Item was changed:
  ----- Method: ScriptEditorMorph>>rowInsertionIndexFor: (in category 'private') -----
  rowInsertionIndexFor: aPoint
  	"Return the row into which the given morph should be inserted."
  
  	| m |
  	firstTileRow to: submorphs size do: [:i |
+ 		m _ submorphs at: i.
- 		m := submorphs at: i.
  		((m top <= aPoint y) and: [m bottom >= aPoint y]) ifTrue:
  			[(aPoint y > m center y)
  				ifTrue: [^ i]
  				ifFalse: [^ (i - 1) max: firstTileRow]]].
  	^ firstTileRow > submorphs size
  		ifTrue:
  			[submorphs size]
  		ifFalse:
  			[(submorphs at: firstTileRow) top > aPoint y 
+ 				ifTrue: [firstTileRow - 1 max: 1 ]
- 				ifTrue: [firstTileRow - 1]
  				ifFalse: [submorphs size]]
  !

Item was added:
+ ----- Method: ScriptEditorMorph>>scriptContainer (in category '*Etoys-Squeakland-access') -----
+ scriptContainer
+ 	"Answer the morph that holds the lines of script."
+ 
+ 	^ self!

Item was changed:
  ----- Method: ScriptEditorMorph>>scriptEdited (in category 'private') -----
  scriptEdited
+ 	"The script was edited in some way.  Recompile the script and be sure appropriate carets are showing."
  
  	| anEditor |
+ 	(anEditor _ self topEditor) ifNotNil:
+ 		[anEditor recompileScript.
+ 		anEditor fixUpCarets]!
- 	(anEditor := self topEditor) ifNotNil: [anEditor recompileScript]!

Item was added:
+ ----- Method: ScriptEditorMorph>>scriptParseNodeIn: (in category '*Etoys-Squeakland-other') -----
+ scriptParseNodeIn: aWorld
+ 
+ 	| n selOrFalse arguments block encoder |
+ 	encoder _ ScriptEncoder new init: playerScripted class context: nil notifying: nil; referenceObject: aWorld.
+ 	n _ MethodNode new.
+ 	selOrFalse _ encoder encodeSelector: scriptName.
+ 
+ 	playerScripted class scripts at: scriptName ifPresent: [:uniclassScript |
+ 		arguments _ uniclassScript argumentVariables asArray collect: [:each |
+ 			encoder bindArg: each variableName.
+ 		].
+ 	].
+ 	arguments ifNil: [
+ 		"In some sort of transition.  Initial creation or name change."
+ 		scriptName numArgs = 0 ifTrue: [
+ 			arguments _ #().
+ 		] ifFalse: [
+ 			arguments _ (Array with: (encoder bindArg: 'parameter')).
+ 		].
+ 	].
+ 
+ 	block _ self parseNodeWith: encoder.
+ 	^ n
+ 		selector: selOrFalse
+ 		arguments: arguments
+ 		precedence: scriptName precedence
+ 		temporaries: #()
+ 		block: block
+ 		encoder: encoder
+ 		primitive: 0.
+ !

Item was added:
+ ----- Method: ScriptEditorMorph>>setupMethodMorph (in category '*Etoys-Squeakland-buttons') -----
+ setupMethodMorph
+ 	"create textual source instead"
+ 
+ 	| aCodePane |
+ 
+ 	aCodePane _ MethodHolder 
+ 		isolatedCodePaneForClass: playerScripted class 
+ 		selector: scriptName.
+ 
+ 	aCodePane
+ 		hResizing: #spaceFill;
+ 		vResizing: #spaceFill;
+ 		minHeight: 100.
+ 	self 
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #shrinkWrap.
+ 	self addMorphBack: aCodePane.
+ 	self fullBounds.
+ 	self 
+ 		listDirection: #topToBottom;
+ 		hResizing: #rigid;
+ 		vResizing: #rigid;
+ 		rubberBandCells: true;
+ 		minWidth: self width.
+ 
+ 	showingMethodPane _ true.
+ 	self currentWorld startSteppingSubmorphsOf: self!

Item was added:
+ ----- Method: ScriptEditorMorph>>sexpScriptWith: (in category '*Etoys-Squeakland-menu') -----
+ sexpScriptWith: aDictionary
+ 	| var pSexp n elements |
+ 	n _ SExpElement keyword: #slot. "script"
+ 	n attributeAt: #name put: 'script'.
+ 	n attributeAt: #scriptName put: scriptName.
+ 	n attributeAt: #type put: 'Player'.
+ 	pSexp _ aDictionary at: playerScripted class ifAbsent: [].
+ 	n attributeAt: #playerClass put: (pSexp ifNotNil: [pSexp idref] ifNil: ['0']).
+ 	n attributeAt: #language put: (self isTextuallyCoded ifTrue: ['Squeak'] ifFalse: ['Etoys']).
+ 	elements _ WriteStream on: (Array new: 20).
+ 	self hasParameter ifTrue: [
+ 		var _ (playerScripted class scripts at: scriptName) argumentVariables first.
+ 		elements nextPut: ((SExpElement keyword: #parameter)
+ 							attributeAt: #type put: var variableType;
+ 							attributeAt: #position put: '1';
+ 							attributeAt: #name put: 'parameter1';
+  							yourself).
+ 	].
+ 
+ 	self isTextuallyCoded ifFalse: [
+ 		elements nextPut: (self sexpWith: aDictionary).
+ 	] ifTrue: [
+ 		^ (playerScripted class decompile: scriptName) sexpWith: aDictionary obj: playerScripted class.
+ 	].
+ 
+ 	n elements: elements contents.
+ 	^ n.
+ !

Item was added:
+ ----- Method: ScriptEditorMorph>>sexpWith: (in category '*Etoys-Squeakland-other') -----
+ sexpWith: dictionary
+ 	| n elements |
+ 	n _ SExpElement keyword: #sequence.
+ 	elements _ WriteStream on: (Array new: self tileRows size).
+ 	self tileRows do: [:r | 
+ 		r do: [:m |
+ 			((m isKindOf: TileMorph) or: [(m isKindOf: CompoundTileMorph) or: [m isKindOf: PhraseTileMorph]]) ifTrue: [
+ 			elements nextPut: (m sexpWith: dictionary)]]].
+ 	n elements: elements contents.
+ 	^ n.
+ 
+ !

Item was changed:
  ----- Method: ScriptEditorMorph>>showSourceInScriptor (in category 'buttons') -----
  showSourceInScriptor
  	"Remove tile panes, if any, and show textual source instead"
  
- 	| aCodePane |
- 
  	self isTextuallyCoded ifFalse: [self becomeTextuallyCoded].
  		"Mostly to fix up grandfathered ScriptEditors"
  
  	self removeAllButFirstSubmorph.
  
+ 	self setupMethodMorph.
+ !
- 	aCodePane := MethodHolder 
- 		isolatedCodePaneForClass: playerScripted class 
- 		selector: scriptName.
- 
- 	aCodePane
- 		hResizing: #spaceFill;
- 		vResizing: #spaceFill;
- 		minHeight: 100.
- 	self 
- 		hResizing: #shrinkWrap;
- 		vResizing: #shrinkWrap.
- 	self addMorphBack: aCodePane.
- 	self fullBounds.
- 	self 
- 		listDirection: #topToBottom;
- 		hResizing: #rigid;
- 		vResizing: #rigid;
- 		rubberBandCells: true;
- 		minWidth: self width.
- 
- 	showingMethodPane := true.
- 	self currentWorld startSteppingSubmorphsOf: self!

Item was added:
+ ----- Method: ScriptEditorMorph>>showingCarets (in category '*Etoys-Squeakland-other') -----
+ showingCarets
+ 	"Answer whether the receiver is in showing-carets mode."
+ 
+ 	^ self valueOfProperty: #showingCarets ifAbsentPut: [true]!

Item was added:
+ ----- Method: ScriptEditorMorph>>showingCaretsString (in category '*Etoys-Squeakland-other') -----
+ showingCaretsString
+ 	"Answer a strilng characterizing whether I am showing carets or not."
+ 
+ 	^ (self showingCarets ifTrue: ['<yes>'] ifFalse: ['<no>']), 'show arrows' translated!

Item was added:
+ ----- Method: ScriptEditorMorph>>sissComeFullyUpOnReloadFrom:to: (in category '*Etoys-Squeakland-serializations') -----
+ sissComeFullyUpOnReloadFrom: from to: to
+ 
+ 	| sexp isTiles morphs row b o methodNode p |
+ 	(self owner notNil and: [self owner owner notNil and: [self owner owner notNil and: [self owner owner owner isMemberOf: TimesRepeatTile]]]) ifTrue: [^ self].
+ 	(self owner notNil and: [self owner owner notNil and: [self owner owner isKindOf: CompoundTileMorph]]) ifTrue: [^ self].
+ 	sexp _ self valueOfProperty: #script.
+ 	self removeProperty: #script.
+ 	b _ bounds.
+ 	o _ owner.
+ 	p _ playerScripted.
+ 	self initialize.
+ 	bounds _ b.
+ 	owner _ o.
+ 	playerScripted _ p.
+ 	sexp ifNil: [^ self].
+ 	self setMorph: playerScripted costume scriptName: (sexp attributeAt: #scriptName) asSymbol.
+ 
+ 	isTiles _ (sexp attributeAt: #language ifAbsent: ['Squeak']) = 'Etoys'.
+ 	isTiles ifTrue: [
+ 		morphs _ (ScriptEditorMorphBuilder context: to playerScripted: playerScripted topEditor: self) fromSexp: (sexp elements detect: [:e | e keyword = #sequence] ifNone: []).
+ 		morphs do: [:e |
+ 			row _ self addNewRow.
+ 			row addMorph: e.
+ 		].
+ 		self install.
+ 	] ifFalse: [
+ 		methodNode _ ParseNodeBuilder new script: sexp with: to in: playerScripted costume referenceWorld.
+ 		playerScripted class addSelectorSilently: methodNode selector withMethod: (methodNode generate: #(0 0 0 0)).
+ 		"playerScripted class compileSilently: code classified: 'scripts'."
+ 		self userScriptObject becomeTextuallyCoded.
+ 		(self submorphs copyFrom: 2 to: self submorphs size) do: [:m | m delete].
+ 		self showSourceInScriptor.
+ 		(playerScripted class scripts at: scriptName) currentScriptEditor: self.
+ 		"(self class scripts at: scriptName) formerScriptingTiles self."
+ 	].
+ 	super sissComeFullyUpOnReloadFrom: from to: to.
+ !

Item was added:
+ ----- Method: ScriptEditorMorph>>sissExportSpecification (in category '*Etoys-Squeakland-serializations') -----
+ sissExportSpecification
+ 	^ playerScripted ifNotNil: [#(('bounds' #bounds)
+ 		('owner' #owner)
+ 		('playerScripted' #playerScripted)
+ 		)] ifNil: [#()].
+ !

Item was added:
+ ----- Method: ScriptEditorMorph>>sissInitializeFrom:from:to: (in category '*Etoys-Squeakland-serializations') -----
+ sissInitializeFrom: sexp from: from to: to
+ 	| varName childInst |
+ 	sexp elements do: [:elem |
+ 		varName _ elem attributeAt: #name ifAbsent: [].
+ 		varName = 'script' ifFalse: [
+ 			childInst _ self fromSexp: elem from: from to: to.
+ 			self sissInstVarNamed: varName put: childInst in: to.
+ 		] ifTrue: [
+ 			self setProperty: #script toValue: elem
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: ScriptEditorMorph>>startTracking (in category '*Etoys-Squeakland-dropping/grabbing') -----
+ startTracking
+ 
+ 	| ed |
+ 	((ed _ ScriptEditorMorph trackedEditor) notNil and: [ed  ~~ self]) ifTrue: [
+ 		ed stopSteppingSelector: #trackDropZones.
+ 		ed removeSpaces.
+ 	].
+ 	ScriptEditorMorph trackedEditor: self.
+ 		
+ 	self startSteppingSelector: #trackDropZones.!

Item was added:
+ ----- Method: ScriptEditorMorph>>stepMe (in category '*Etoys-Squeakland-etoys-debugger') -----
+ stepMe
+ 	self etoysDebugger evaluateNextTile !

Item was added:
+ ----- Method: ScriptEditorMorph>>stopTracking (in category '*Etoys-Squeakland-dropping/grabbing') -----
+ stopTracking
+ 
+ 	| ed |
+ 	(((ed _ ScriptEditorMorph trackedEditor) notNil) and: [ed ~~ self]) ifTrue: [
+ 		ed stopSteppingSelector: #trackDropZones.
+ 		ed removeSpaces.
+ 	].
+ 	self stopSteppingSelector: #trackDropZones.
+ 	handWithTile _ nil.
+ 	ScriptEditorMorph trackedEditor: nil.
+ 
+ !

Item was added:
+ ----- Method: ScriptEditorMorph>>tiles (in category '*Etoys-Squeakland-etoys-debugger') -----
+ tiles
+ 	^ self tileRows collect: [:each | each first]!

Item was added:
+ ----- Method: ScriptEditorMorph>>toggleShowingCarets (in category '*Etoys-Squeakland-other') -----
+ toggleShowingCarets
+ 	"Toggle whether I'm showing carets."
+ 
+ 	self setProperty: #showingCarets toValue: self showingCarets not.
+ 	self fixUpCarets.
+ 	self install!

Item was changed:
  ----- Method: ScriptEditorMorph>>toggleWhetherShowingTiles (in category 'other') -----
  toggleWhetherShowingTiles
  	"Toggle between showing the method pane and showing the tiles pane"
  
  	self showingMethodPane
  		ifFalse:				"currently showing tiles"
  			[self showSourceInScriptor]
  
  		ifTrue:				"current showing textual source"
  			[Preferences universalTiles
  				ifTrue: [^ self revertToTileVersion].
  			self savedTileVersionsCount >= 1
  				ifTrue:
+ 					[(self userScriptObject lastSourceString = (playerScripted class sourceCodeAt: scriptName))
- 					[(self userScriptObject lastSourceString = (playerScripted class compiledMethodAt: scriptName) decompileString)
  						ifFalse:
  							[(self confirm: 
  'Caution -- this script was changed
  textually; if you revert to tiles at this
  point you will lose all the changes you
  may have made textually.  Do you
  really want to do this?' translated) ifFalse: [^ self]].
  					self revertToTileVersion]
  				ifFalse:
  					[Beeper beep]]!

Item was changed:
  ----- Method: ScriptEditorMorph>>trackDropZones (in category 'dropping/grabbing') -----
  trackDropZones
  	"The fundamental heart of script-editor layout, by Dan Ingalls in fall 1997, though many hands have touched it since."
  
  	| hand insertion i space1 d space2 insHt nxtHt prevBot ht2 c1 c2 ii where |
+ 	hand _ handWithTile ifNil: [self primaryHand].
+ 	previousDropHandPosition = hand position ifTrue: [^ self].
+ 	previousDropHandPosition _ hand position.
- 	hand := handWithTile ifNil: [self primaryHand].
  	((self hasOwner: hand) not and: [hand submorphCount > 0])
  		ifTrue:
+ 			[insertion _ hand firstSubmorph renderedMorph.
+ 			insHt _ insertion fullBounds height.
+ 			self removeDropSpaces.
+ 			where _ self globalPointToLocal: hand position"insertion fullBounds topLeft".
+ 			i _ (ii _ self indexOfMorphAbove: where) min: submorphs size-1.
+ 			prevBot _ i <= 0 ifTrue: [(self innerBounds) top]
- 			[insertion := hand firstSubmorph renderedMorph.
- 			insHt := insertion fullBounds height.			self removeSpaces.
- 			where := self globalPointToLocal: hand position"insertion fullBounds topLeft".
- 			i := (ii := self indexOfMorphAbove: where) min: submorphs size-1.
- 			prevBot := i <= 0 ifTrue: [(self innerBounds) top]
  							ifFalse: [(self submorphs at: i) bottom].
+ 			nxtHt _ (submorphs isEmpty
+ 				ifTrue: [(self owner isMemberOf: AlignmentMorph) ifTrue: [Morph new extent: 0 at 10] ifFalse: [insertion]]
+ 				ifFalse: [self submorphs at: i+1]) height max: 1.
+ 			"nxtHt printString displayAt: 0 at 0."
+ 			d _ ii > i ifTrue: [nxtHt "for consistent behavior at bottom"]
- 			nxtHt := (submorphs isEmpty
- 				ifTrue: [insertion]
- 				ifFalse: [self submorphs at: i+1]) height.
- 			d := ii > i ifTrue: [nxtHt "for consistent behavior at bottom"]
  					ifFalse: [0 max: (where y - prevBot min: nxtHt)].
  
  			"Top and bottom spacer heights cause continuous motion..."
+ 			c1 _ Color green.  c2 _ Color transparent.
+ 			ht2 _ d*insHt//nxtHt.
+ 			"'d, insHt, nxtHt', d printString, '  ', insHt printString, '  ', nxtHt printString, '  ', ht2 printString, '                   ' displayAt: 0 at 50."
+ 			dropSpaces ifNil: [
+ 				dropSpaces _ Array new: 2.
+ 				dropSpaces at: 1 put: Morph new.
+ 				dropSpaces at: 2 put: Morph new.
+ 			].
+ 			space1 _ dropSpaces at: 1.
+ 			space2 _ dropSpaces at: 2.
+ 			space1 privateBounds: (0 at 0 extent: (self width - (self borderWidth*2) - 10)@(insHt-ht2));
- 			c1 := Color green.  c2 := Color transparent.
- 			ht2 := d*insHt//nxtHt.
- 			space1 := Morph newBounds: (0 at 0 extent: 30@(insHt-ht2))
                                          color: ((insHt-ht2) > (insHt//2+1) ifTrue: [c1] ifFalse: [c2]).
+ 			space2 privateBounds: (0 at 0 extent: (self width - (self borderWidth*2) - 10)@ht2);
- 			self privateAddMorph: space1 atIndex: (i+1 max: 1).
- 			space2 := Morph newBounds: (0 at 0 extent: 30 at ht2)
                                          color: (ht2 > (insHt//2+1) ifTrue: [c1] ifFalse: [c2]).
+ 			self privateAddMorph: (space1 position: where) atIndex: (i+1 max: 1).
+ 			self privateAddMorph: (space2 position: where) atIndex: (i+3 min: submorphs size+1).
+ 
+ 			]
- 			self privateAddMorph: space2 atIndex: (i+3 min: submorphs size+1)]
  		ifFalse:
+ 			[self stopTracking. self removeSpaces]!
- 			[self stopSteppingSelector: #trackDropZones.
- 			self removeSpaces]!

Item was changed:
  ----- Method: ScriptEditorMorph>>tryMe (in category 'buttons') -----
  tryMe
  	"Evaluate the given script on behalf of the scripted object"
  
  	scriptName numArgs = 0
  		ifTrue:
+ 			[self deleteEtoysDebugger.
+ 			self playerScripted performScriptIfCan: scriptName ]
- 			[self playerScripted performScriptIfCan: scriptName ]
  
  !

Item was changed:
  ----- Method: ScriptEditorMorph>>typeInFrequency (in category 'frequency') -----
  typeInFrequency
  	| reply aNumber |
+ 	reply _ FillInTheBlank request: 'Number of firings per tick: ' translated initialAnswer: self scriptInstantiation frequency printString.
- 	reply := UIManager default request: 'Number of firings per tick: ' translated initialAnswer: self scriptInstantiation frequency printString.
  
  	reply ifNotNil:
+ 		[aNumber _ reply asNumber.
- 		[aNumber := reply asNumber.
  		aNumber > 0 ifTrue:
  			[self setFrequencyTo: aNumber]]!

Item was changed:
  ----- Method: ScriptEditorMorph>>unhibernate (in category 'other') -----
  unhibernate
  	"I have been loaded as part of an ImageSegment.
  	Make sure that I am fixed up properly."
+ 	self topEditor == self ifFalse: [^ self]. "Part of a compound test"
- 	| fixMe |
- 	(fixMe := self valueOfProperty: #needsLayoutFixed ifAbsent: [ false ])
- 		ifTrue: [self removeProperty: #needsLayoutFixed ].
- 
- 	self topEditor == self
- 		ifFalse: [^ self]. "Part of a compound test"
- 
  	self updateHeader.
+ 	self fixUpCarets.
+ 	self fixLayout.
- 	fixMe ifTrue: [ self fixLayout. self removeProperty: #needsLayoutFixed ].
- 
  	"Recreate my tiles from my method if i have new universal tiles."
- 
  	self world
+ 		ifNil: [(playerScripted isNil or: [playerScripted isUniversalTiles not]) ifTrue: [^ self]]
+ 		ifNotNil:
+ 			[Preferences universalTiles ifFalse: [^ self]].
+ 
- 		ifNil: [(playerScripted isNil
- 					or: [playerScripted isUniversalTiles not])
- 				ifTrue: [^ self]]
- 		ifNotNil: [Preferences universalTiles
- 				ifFalse: [^ self]].
  	self insertUniversalTiles.
  	self showingMethodPane: false!

Item was changed:
  ----- Method: ScriptEditorMorph>>updateStatus (in category 'buttons') -----
  updateStatus
  	"Update that status in the receiver's header.  "
  
+ 	(self topEditor == self and: [firstTileRow ~~ 1]) ifTrue:
+ 		[(submorphs size == 0 or: [(self firstSubmorph findA: ScriptStatusControl) isNil])
- 	(self topEditor == self and: [firstTileRow ~= 1]) ifTrue:
- 		[(submorphs size = 0 or: [(self firstSubmorph findA: ScriptStatusControl) isNil])
  			ifTrue:
  				[self replaceRow1].
  		self updateStatusMorph: (self firstSubmorph findA: ScriptStatusControl)]!

Item was changed:
  ----- Method: ScriptEditorMorph>>userScriptObject (in category 'other') -----
  userScriptObject
+ 	"Answer the user-script object associated with the receiver.  This is expected to be called only for objects that actually reside within 'Scriptors', but will return nil, rather than fail, of there is no userScriptObject found."
- 	"Answer the user-script object associated with the receiver"
  
  	| aPlayerScripted topEd |
+ 	aPlayerScripted _ (topEd _ self topEditor) playerScripted.
+ 	^ aPlayerScripted ifNotNil: [ aPlayerScripted class userScriptForPlayer: aPlayerScripted selector: topEd scriptName]!
- 	aPlayerScripted := (topEd := self topEditor) playerScripted.
- 	^ aPlayerScripted class userScriptForPlayer: aPlayerScripted selector: topEd scriptName !

Item was changed:
  ----- Method: ScriptEditorMorph>>veryDeepInner: (in category 'copying') -----
  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.
+ 	scriptName _ scriptName veryDeepCopyWith: deepCopier.
+ 	firstTileRow _ firstTileRow veryDeepCopyWith: deepCopier.
+ 	timeStamp _ timeStamp veryDeepCopyWith: deepCopier.
+ 	playerScripted _ playerScripted.		"Weakly copied"
+ 	handWithTile _ nil.  "Just a cache"
+ 	showingMethodPane _ showingMethodPane.	"boolean"
+ 	threadPolygon _ nil. "Just a cache".
+ 	previousDropHandPosition _ nil.
+ 	dropSpaces _ nil.
- 	scriptName := scriptName veryDeepCopyWith: deepCopier.
- 	firstTileRow := firstTileRow veryDeepCopyWith: deepCopier.
- 	timeStamp := timeStamp veryDeepCopyWith: deepCopier.
- 	playerScripted := playerScripted.		"Weakly copied"
- 	handWithTile := nil.  "Just a cache"
- 	showingMethodPane := showingMethodPane.	"boolean"
- 	threadPolygon := nil. "Just a cache".
- 
  !

Item was added:
+ ----- Method: ScriptEditorMorph>>viewerTile (in category '*Etoys-Squeakland-access') -----
+ viewerTile
+ 	| viewers category viewerline |
+ 	viewers := playerScripted allOpenViewersOnReceiverAndSiblings.
+ 	viewers isEmpty
+ 		ifTrue: [^ nil].
+ 	category := viewers first categoryMorphs
+ 				detect: [:e | e chosenCategorySymbol = #scripts]
+ 				ifNone: [^ nil].
+ 	viewerline := category submorphs
+ 				detect: [:e | (e isKindOf: ViewerLine)
+ 						and: [e elementSymbol = scriptName]]
+ 				ifNone: [^ nil].
+ 	viewerline world
+ 		ifNil: [^ nil].
+ 	^ viewerline!

Item was added:
+ Object subclass: #ScriptEditorMorphBuilder
+ 	instanceVariableNames: 'context playerScripted topEditor'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Scripting'!

Item was added:
+ ----- Method: ScriptEditorMorphBuilder class>>context:playerScripted:topEditor: (in category 'as yet unclassified') -----
+ context: c playerScripted: p topEditor: t
+ 
+ 	^ self new context: c playerScripted: p topEditor: t
+ !

Item was added:
+ ----- Method: ScriptEditorMorphBuilder>>assign: (in category 'reconstituting scripting tiles ') -----
+ assign: sexp
+ 
+ 	| rcvr propertyName updating rhs p |
+ 	rcvr _ self fromSexp: sexp elements first.
+ 
+ 	propertyName _ sexp attributeAt: #property ifAbsent: [self error: ''].
+ 	propertyName _ propertyName asSymbol.
+ 	(#(patchValueIn: setRedComponentIn: setGreenComponentIn: setBlueComponentIn:) includes: propertyName) ifTrue: [
+ 		^ self specialAssign: sexp with: rcvr.
+ 	].
+ 
+ 	updating _ sexp attributeAt: #updating ifAbsent: [nil].
+ 	rhs _ self fromSexp: sexp elements last.
+ 
+ 	p _ PhraseTileMorph new
+ 		setAssignmentRoot: propertyName asSymbol
+ 			type: #command
+ 			rcvrType: #Player
+ 			argType: (sexp attributeAt: #type ifAbsent: [#Number]) asSymbol
+ 			vocabulary: self currentVocabulary.
+ 	p justGrabbedFromViewer: false.
+ 	updating ifNotNil: [p  submorphs second value: updating].
+ 	p submorphs first addMorph: rcvr.
+ 	p submorphs third setType: (sexp elements last attributeAt: #type ifAbsent: [#Number]) asSymbol.
+ 	p submorphs third addMorph: rhs.
+ 	(rhs resultType == #Number and: [rhs isMemberOf: TileMorph]) ifTrue: [
+ 		rhs addSuffixArrow.
+ 	].
+ 
+ 	^ p.
+ !

Item was added:
+ ----- Method: ScriptEditorMorphBuilder>>condition: (in category 'reconstituting scripting tiles ') -----
+ condition: sexp
+ 
+ 	| p testPart yesPart noPart n |
+ 	testPart _ self fromSexp: (sexp elements first).
+ 	yesPart _ self fromSexp: (sexp elements second).
+ 	noPart _ self fromSexp: (sexp elements third).
+ 
+ 	p _ CompoundTileMorph new.
+ 	testPart = #() ifFalse: [
+ 		p submorphs first submorphs last addNewRow addMorph: testPart.
+ 	].
+ 
+ 	yesPart do: [:e |
+ 		n _ p submorphs second submorphs last addNewRow.
+ 		n addMorph: e.
+ 	].
+ 	noPart do: [:e |
+ 		n _ p submorphs third submorphs last addNewRow.
+ 		n addMorph: e.
+ 	].
+ 	^ p.
+ !

Item was added:
+ ----- Method: ScriptEditorMorphBuilder>>context:playerScripted: (in category 'initialization') -----
+ context: c playerScripted: p
+ 
+ 	context _ c.
+ 	playerScripted _ p.
+ !

Item was added:
+ ----- Method: ScriptEditorMorphBuilder>>context:playerScripted:topEditor: (in category 'initialization') -----
+ context: c playerScripted: p topEditor: t
+ 
+ 	context _ c.
+ 	playerScripted _ p.
+ 	topEditor _ t.
+ !

Item was added:
+ ----- Method: ScriptEditorMorphBuilder>>fromSexp: (in category 'initialization') -----
+ fromSexp: sexp
+ 
+ 	^ self perform: (sexp keyword copyWith: $:) asSymbol with: sexp.
+ !

Item was added:
+ ----- Method: ScriptEditorMorphBuilder>>functionSend:with:with: (in category 'reconstituting scripting tiles ') -----
+ functionSend: sexp with: rcvr with: realSel
+ 
+ 	| p |
+ 	p _ FunctionTile new.
+ 	p operator: realSel pad: rcvr.
+ 	^ p.
+ !

Item was added:
+ ----- Method: ScriptEditorMorphBuilder>>literal: (in category 'reconstituting scripting tiles ') -----
+ literal: sexp
+ 	"Answer an appropriate tile morph reconstituted from the s-expression provided."
+ 
+ 	| type n lit s xComp yComp |
+ 	type _ sexp attributeAt: #type ifAbsent: [].
+ 	type ifNotNil: [type _ type asSymbol].
+ 	(type == #Player or: [type == #Patch]) ifTrue: [
+ 		n _ sexp attributeAt: #value ifAbsent: [].
+ 		n ifNotNil: [
+ 			n = 'self' ifTrue: [^ TileMorph new setToReferTo: playerScripted].
+ 			n = 'nil' ifTrue: [^ TileMorph new setToReferTo: playerScripted presenter standardPlayer].
+ 			^ TileMorph new setToReferTo: (context at: n asSymbol)
+ 		].
+ 		^ TileMorph new setToReferTo: World presenter standardPlayer
+ 	].
+ 	type == #String ifTrue: [
+ 		lit _ sexp attributeAt: #value.
+ 		^ (TileMorph new setLiteral: lit).
+ 	].
+ 	type == #Point ifTrue: [
+ 		lit _ sexp attributeAt: #value.
+ 		xComp _ lit copyFrom: 1 to: (lit indexOf: $@) - 1.
+ 		yComp _ lit copyFrom: (lit indexOf: $@) + 1 to: lit size.
+ 		
+ 		lit _ xComp asNumber at yComp asNumber.
+ 		^ (TileMorph new setLiteral: lit).
+ 	].
+ 	type == #Color ifTrue: [
+ 		lit _ Color readFrom: (sexp attributeAt: #value).
+ 		^ ColorTileMorph new colorSwatchColor: lit.
+ 	].
+ 	type == #Boolean ifTrue: [
+ 		lit _ (sexp attributeAt: #value) = 'true'.
+ 		^ TileMorph new addArrows; setLiteral: lit
+ 
+ 	].
+ 	type == #Sound ifTrue: [
+ 		lit _ sexp attributeAt: #value.
+ 		^ SoundTile new literal: lit.
+ 	].
+ 	type == #ScriptName ifTrue: [
+ 		lit _ sexp attributeAt: #value.
+ 		^ ScriptNameTile new literal: lit asSymbol.
+ 	].
+ 
+ 	(type == #Object or: [type == #Number]) ifTrue: [
+ 		lit _ Number readFrom: (sexp attributeAt: #value).
+ 		^ (TileMorph new setLiteral: lit)
+ 				setDecimalPlacesFromTypeIn: (sexp attributeAt: #value);
+ 				addArrows.
+ 	].
+ 	(type == #Graphic) ifTrue: [
+ 		lit _ (context at: (sexp attributeAt: #value) asSymbol).
+ 		^ (GraphicTile new setLiteral: lit).
+ 	].
+ 	(type == #Menu) ifTrue: [
+ 		lit _ sexp attributeAt: #value.
+ 		^ (MenuTile new setLiteral: lit).
+ 	].
+ 
+ 	((Vocabulary allStandardVocabularies select: [:m | m isKindOf: SymbolListType]) includesKey: type)
+ 		ifTrue:
+ 			[lit _ sexp attributeAt: #value.
+ 			s _ SymbolListTile new.
+ 			s choices: (Vocabulary allStandardVocabularies at: type) choices dataType: type.
+ 			^ s setLiteral: lit asSymbol; addArrows]!

Item was added:
+ ----- Method: ScriptEditorMorphBuilder>>loop: (in category 'reconstituting scripting tiles ') -----
+ loop: sexp
+ 	"Answer a TimesRepeatTile derived from the s-expression provided."
+ 
+ 	| p test body whatToRepeatPart numberOfTimesToRepeatPart |
+ 	"You can think of different loops, but for current Etoys, there is only one kind."
+ 	"initial _ sexp elements detect: [:e | e keyword == #initial] ifNone: [nil].
+ 	increment _ sexp elements detect: [:e | e keyword == #increment] ifNone: [nil]."
+ 	test _ sexp elements detect: [:e | e keyword == #test] ifNone: [nil].
+ 	body _ sexp elements detect: [:e | e keyword == #sequence] ifNone: [nil].
+ 
+ 	test _ self fromSexp: test elements first.
+ 
+ 	body _ self fromSexp: body.
+ 	p _ TimesRepeatTile new.
+ 	numberOfTimesToRepeatPart _ p numberOfTimesToRepeatPart.
+ 	numberOfTimesToRepeatPart removeAllMorphs; addMorph: test.
+ 	whatToRepeatPart _ p instVarNamed: 'whatToRepeatPart'.
+ 	body do: [:b |
+ 		whatToRepeatPart addNewRow addMorph: b.
+ 	].
+ 	^ p.
+ !

Item was added:
+ ----- Method: ScriptEditorMorphBuilder>>phraseForSpecialKedamaSend: (in category 'reconstituting scripting tiles ') -----
+ phraseForSpecialKedamaSend: realSel
+ 
+ 	realSel == #getPatchValueIn: ifTrue: [
+ 		^ PhraseTileMorph new setGetPixelOperator: realSel type: #Number rcvrType: #Player argType: #Patch.
+ 	].
+ 	realSel == #getAngleTo: ifTrue: [
+ 		^ PhraseTileMorph new setAngleToOperator: realSel type: #Number rcvrType: #Player argType: #Player.
+ 	].
+ 	realSel == #bounceOn: ifTrue: [
+ 		^ PhraseTileMorph new setBounceOnOperator: realSel type: #Boolean rcvrType: #Player argType: #Player.
+ 	].
+ 	realSel == #getDistanceTo: ifTrue: [
+ 		^ PhraseTileMorph new setDistanceToOperator: realSel type: #Number rcvrType: #Player argType: #Player
+ 	].
+ 	realSel == #getTurtleOf: ifTrue: [
+ 		^ PhraseTileMorph new setTurtleOfOperator: realSel type: #Player rcvrType: #Player argType: #Player
+ 	].
+ 	realSel == #getUphillIn: ifTrue: [
+ 		^ PhraseTileMorph new setUpHillOperator: realSel type: #Number rcvrType: #Player argType: #Player
+ 	].
+ 	realSel == #getRedComponentIn: ifTrue: [
+ 		^ PhraseTileMorph new setGetColorComponentOperator: realSel componentName: #red type: #Number rcvrType: #Player argType: #Patch
+ 	].
+ 	realSel == #getGreenComponentIn: ifTrue: [
+ 		^ PhraseTileMorph new setGetColorComponentOperator: realSel componentName: #green type: #Number rcvrType: #Player argType: #Patch
+ 	].
+ 	realSel == #getBlueComponentIn: ifTrue: [
+ 		^ PhraseTileMorph new setGetColorComponentOperator: realSel componentName: #blue type: #Number rcvrType: #Player argType: #Patch
+ 	].
+ 
+ 	^ nil.
+ !

Item was added:
+ ----- Method: ScriptEditorMorphBuilder>>script: (in category 'reconstituting scripting tiles ') -----
+ script: sexp
+ 
+ 	| scriptName params entry morphs row isTiles code |
+ 	scriptName _ (sexp attributeAt: #scriptName) asSymbol.
+ 	params _ sexp elements select: [:e | e keyword == #parameter].
+ 
+ 	entry _ playerScripted class permanentUserScriptFor: scriptName asSymbol player: playerScripted.
+ 
+ 	params _ params collect: [:e | Variable new name: (e attributeAt: #name) asSymbol type: (e attributeAt: #type) asSymbol].
+ 	entry argumentVariables: params.
+ 	topEditor _ entry instantiatedScriptEditorForPlayer: playerScripted.
+ 
+ 	isTiles _ (sexp attributeAt: #language ifAbsent: ['Squeak']) = 'Etoys'.
+ 	isTiles ifTrue: [
+ 		morphs _ self fromSexp: (sexp elements detect: [:e | e keyword == #sequence] ifNone: []).
+ 		morphs do: [:e |
+ 			row _ topEditor addNewRow.
+ 			row addMorph: e.
+ 		].
+ 	] ifFalse: [
+ 		code _ (sexp elements detect: [:e | e keyword == #code]) attributeAt: #value.
+ 		playerScripted class compileSilently: code classified: 'scripts'.
+ 		topEditor userScriptObject becomeTextuallyCoded.
+ 		(topEditor submorphs copyFrom: 2 to: topEditor submorphs size) do: [:m | m delete].
+ 		topEditor showSourceInScriptor.
+ 	].
+ 
+ 	^ entry.
+ !

Item was added:
+ ----- Method: ScriptEditorMorphBuilder>>send: (in category 'reconstituting scripting tiles ') -----
+ send: sexp
+ 
+ 	| rcvr type selNode realSel val p argType |
+ 	rcvr _ self fromSexp: sexp elements second.
+ 	type _ sexp attributeAt: #type ifAbsent: ['#Player'].
+ 	selNode _ sexp elements first.
+ 	realSel _ selNode attributeAt: #getter ifAbsent: [].
+ 	realSel ifNotNil: [
+ 		realSel _ Utilities getterSelectorFor: realSel.
+ 		(rcvr isMemberOf: PhraseTileMorph) ifFalse: [rcvr bePossessive].
+ 	] ifNil: [
+ 		realSel _ (selNode attributeAt: #selector) asSymbol.
+ 		"realSel ifNil: [self error: '']."
+ 	].
+ 	(#(getAngleTo: bounceOn: getDistanceTo: getPatchValueIn: getTurtleOf: getUphillIn: getRedComponentIn: getGreenComponentIn: getBlueComponentIn:) includes: realSel) ifTrue: [
+ 		^ self specialKedamaSend: sexp with: rcvr with: realSel
+ 	].
+ 	(#(color:sees:) includes: realSel) ifTrue: [
+ 		^ self specialSend: sexp with: rcvr with: realSel
+ 	].
+ 	((ScriptingSystem tableOfNumericFunctions collect: [:e | e second]) includes: realSel) ifTrue: [
+ 		^ self functionSend: sexp with: rcvr with: realSel
+ 	].
+ 
+ 	p _ PhraseTileMorph new
+ 			setOperator: realSel
+ 				type: type asSymbol
+ 				rcvrType: #Player
+ 				argType: #Number.
+ 	p justGrabbedFromViewer: false.
+ 	p submorphs first addMorph: rcvr.
+ 	p submorphs first setType: (sexp elements second attributeAt: #type ifAbsent: ['Number']) asSymbol.
+ 	sexp elements size = 2 ifTrue: [
+ 		(p resultType == #Number and: [p submorphs second isMemberOf: TileMorph]) ifTrue: [
+ 			p submorphs second addSuffixArrow.
+ 		].
+ 	].
+ 	sexp elements size > 2 ifTrue: [
+ 		val _ self fromSexp: sexp elements third.
+ 		argType _ (sexp elements third attributeAt: #type ifAbsent: ['Number']) asSymbol.
+ 		p submorphs third setType: argType.
+ 		p submorphs third addMorph: val.
+ 		(argType == #Number and: [val isMemberOf: TileMorph]) ifTrue: [val addSuffixArrow.
+ 			(#(#+ #- #* #/ #'//' #'\\' #max: #min: #< #'<=' #= #'~=' #> #'>=' #isDivisibleBy:) includes: realSel) ifFalse: [p submorphs second addRetractArrowAnyway].
+ 		].
+ 	].
+ 	^ p.
+ !

Item was added:
+ ----- Method: ScriptEditorMorphBuilder>>sequence: (in category 'reconstituting scripting tiles ') -----
+ sequence: sexp
+ 
+ 	^ sexp elements collect: [:elem |
+ 		self fromSexp: elem.
+ 	].
+ !

Item was added:
+ ----- Method: ScriptEditorMorphBuilder>>specialAssign:with: (in category 'reconstituting scripting tiles ') -----
+ specialAssign: sexp with: rcvr
+ 
+ 	| propertyName updating rhs patch p componentName |
+ 	propertyName _ (sexp attributeAt: #property) asSymbol.
+ 	updating _ sexp attributeAt: #updating ifAbsent: [nil].
+ 	rhs _ self fromSexp: sexp elements last.
+ 	(propertyName == #patchValueIn:) ifTrue: [
+ 		patch _ self fromSexp: sexp elements second.
+ 
+ 		p _ PhraseTileMorph new
+ 			setPixelValueRoot: propertyName asSymbol
+ 				type: #command
+ 				rcvrType: #Player
+ 				argType: #Number
+ 				vocabulary: self currentVocabulary.
+ 		p justGrabbedFromViewer: false.
+ 		updating ifNotNil: [p submorphs second value: updating].
+ 		p submorphs first addMorph: rcvr.
+ 		p submorphs third setType: (sexp elements last attributeAt: #type ifAbsent: [#Number]) asSymbol.
+ 		p submorphs third addMorph: rhs.
+ 		p submorphs second setPatchDefaultTo: patch actualObject.
+ 		^ p.
+ 	].
+ 	(propertyName == #setRedComponentIn:) ifTrue: [componentName _ #red].
+ 	(propertyName == #setGreenComponentIn:) ifTrue: [componentName _ #green].
+ 	(propertyName == #setBlueComponentIn:) ifTrue: [componentName _ #blue].
+ 
+ 	(#(setRedComponentIn: setGreenComponentIn: setBlueComponentIn:) includes: propertyName) ifTrue: [
+ 		patch _ self fromSexp: sexp elements second.
+ 
+ 		p _ PhraseTileMorph new
+ 					setColorComponentRoot: propertyName
+ 					componentName: componentName
+ 					type: #command
+ 					rcvrType: #Patch
+ 					argType: #Number
+ 					vocabulary: self currentVocabulary.
+ 		p justGrabbedFromViewer: false.
+ 		updating ifNotNil: [p submorphs second value: updating].
+ 		p submorphs first addMorph: rcvr.
+ 		p submorphs third setType: (sexp elements last attributeAt: #type ifAbsent: [#Number]) asSymbol.
+ 		p submorphs third addMorph: rhs.
+ 		p submorphs second setPatchDefaultTo: patch actualObject.
+ 		^ p.
+ 	].
+ 
+ !

Item was added:
+ ----- Method: ScriptEditorMorphBuilder>>specialKedamaSend:with:with: (in category 'reconstituting scripting tiles ') -----
+ specialKedamaSend: sexp with: rcvr with: realSel
+ 
+ 	| p val |
+ 	val _ self fromSexp: sexp elements third.
+ 	p _ self phraseForSpecialKedamaSend: realSel.
+ 	p justGrabbedFromViewer: false.
+ 	p submorphs first addMorph: rcvr.
+ 	p submorphs second setArgumentDefaultTo: val actualObject.
+ 	^ p
+ !

Item was added:
+ ----- Method: ScriptEditorMorphBuilder>>specialSend:with:with: (in category 'reconstituting scripting tiles ') -----
+ specialSend: sexp with: rcvr with: realSel
+ 
+ 	| p val |
+ 	sexp elements size > 2 ifTrue: [
+ 		val _ self fromSexp: sexp elements third.
+ 	].
+ 	realSel == #color:sees: ifTrue: [
+ 		p _  PhraseTileMorph new 
+ 				setOperator: #+
+ 				type: #Boolean
+ 				rcvrType: #Player
+ 				argType: #Color.	"temp dummy"
+ 		p justGrabbedFromViewer: false.
+ 		p submorphs first addMorph: rcvr.
+ 		p submorphs second delete.
+ 		p addMorph: (ColorSeerTile new showPalette: false; colorSwatchColor: (val colorSwatch color)) behind: p submorphs first.
+ 		p submorphs last setType: (sexp elements fourth attributeAt: #type ifAbsent: ['Number']) asSymbol.
+ 		p submorphs last addMorph: (self fromSexp: sexp elements fourth).
+ 		^ p.
+ 	].
+ !

Item was added:
+ ----- Method: ScriptEditorMorphBuilder>>topEditor (in category 'e-toy support') -----
+ topEditor
+ 
+ 	^ topEditor.
+ !

Item was added:
+ ----- Method: ScriptEditorMorphBuilder>>variable: (in category 'reconstituting scripting tiles ') -----
+ variable: sexp
+ 
+ 	| p |
+ 	p _ ParameterTile new.
+ 	p scriptEditor: topEditor.
+ 	p line1: (sexp attributeAt: #type) translated.
+ 	^ p.
+ !

Item was added:
+ EncoderForV3PlusClosures subclass: #ScriptEncoder
+ 	instanceVariableNames: 'referenceObject'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Compiler'!

Item was added:
+ ----- Method: ScriptEncoder>>computeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method generation') -----
+ computeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex
+ 	"copied from superclass, only change is the >>headerFlagForEncoder: argument"
+ 	numArgs > 15 ifTrue:
+ 		[^self error: 'Cannot compile -- too many arguments'].
+ 	numTemps > 63 ifTrue:
+ 		[^self error: 'Cannot compile -- too many temporary variables'].	
+ 	numLits > 65535 ifTrue:
+ 		[^self error: 'Cannot compile -- too many literals'].
+ 	^(CompiledMethod headerFlagForEncoder: EncoderForV3PlusClosures new)
+ 	+ (numArgs bitShift: 24)
+ 	+ (numTemps bitShift: 18)
+ 	"+ (largeBit bitShift: 17)" "largeBit gets filled in later"
+ 	+ (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])
+ 	+ numLits!

Item was added:
+ ----- Method: ScriptEncoder>>encodePlayer: (in category 'as yet unclassified') -----
+ encodePlayer: anObject
+ 
+ 	| n |
+ 	n _ referenceObject uniqueNameForReferenceFor: anObject.
+ 	^ self encodeVariable: n.
+ !

Item was added:
+ ----- Method: ScriptEncoder>>init:context:notifying: (in category 'as yet unclassified') -----
+ init: class context: ctxt notifying: parser
+ 
+ 	super
+ 		init: (CompilationCue
+ 				source: nil
+ 				context: ctxt
+ 				receiver: nil
+ 				class: class
+ 				environment: class environment
+ 				requestor: nil)
+ 		notifying: parser!

Item was added:
+ ----- Method: ScriptEncoder>>lookupInPools:ifFound: (in category 'private') -----
+ lookupInPools: varName ifFound: assocBlock
+ 
+ 	referenceObject referencePool ifNotNil: [:pool |
+ 		(pool bindingOf: varName asSymbol) ifNotNilDo:[:assoc| 
+ 			assocBlock value: assoc.
+ 			^ true]].
+ 	^ super lookupInPools: varName ifFound: assocBlock.
+ !

Item was added:
+ ----- Method: ScriptEncoder>>referenceObject: (in category 'as yet unclassified') -----
+ referenceObject: anObject
+ 
+ 	referenceObject _ anObject.
+ !

Item was changed:
  ----- Method: ScriptInstantiation>>defineNewEvent (in category 'customevents-status control') -----
  defineNewEvent
  	| newEventName newEventHelp |
  	"Prompt the user for the name of a new event and install it into the custom event table"
+ 	newEventName _ FillInTheBlankMorph request: 'What is the name of your new event?' translated.
- 	newEventName := FillInTheBlankMorph request: 'What is the name of your new event?'.
  	newEventName isEmpty ifTrue: [ ^self ].
+ 	newEventName _ newEventName asSymbol.
- 	newEventName := newEventName asSymbol.
  	(ScriptingSystem customEventStati includes: newEventName) ifTrue: [
+ 		self inform: 'That event is already defined.' translated. ^self ].
+ 	newEventHelp _ FillInTheBlankMorph request: 'Please describe this event:' translated.
- 		self inform: 'That event is already defined.'. ^self ].
- 	newEventHelp := FillInTheBlankMorph request: 'Please describe this event:'.
  	ScriptingSystem addUserCustomEventNamed: newEventName help: newEventHelp.!

Item was changed:
  ----- Method: ScriptInstantiation>>explainStatusAlternatives (in category 'customevents-status control') -----
  explainStatusAlternatives
  	"Open a little window that explains the various status 
  	alternatives "
+ 
+ 	ScriptingSystem putUpInfoPanelFor:(ScriptingSystem statusHelpStringFor: player) title: 'Script Status' translated extent: 800 at 500!
- 	(StringHolder new contents: (ScriptingSystem statusHelpStringFor: player))
- 		openLabel: 'Script Status' translated!

Item was changed:
  ----- Method: ScriptInstantiation>>offerMenuIn: (in category 'misc') -----
  offerMenuIn: aStatusViewer
  	"Put up a menu."
  
  	| aMenu |
  	ActiveHand showTemporaryCursor: nil.
+ 	aMenu _ MenuMorph new defaultTarget: self.
- 	aMenu := MenuMorph new defaultTarget: self.
  	aMenu title: player knownName, ' ', selector.
  	aMenu addStayUpItem.
  	(player class instanceCount > 1) ifTrue:
  		[aMenu add: 'propagate status to siblings' translated selector: #assignStatusToAllSiblingsIn: argument: aStatusViewer.
  		aMenu balloonTextForLastItem: 'Make the status of this script in all of my sibling instances be the same as the status you see here' translated].
+ 	aMenu addLine.
  
+ 	aMenu add: 'grab this object' translated target: player selector: #grabPlayerIn: argument: ActiveWorld.
+ 	aMenu balloonTextForLastItem: 'This will actually pick up the object bearing this script and hand it to you.  Click the (left) button to drop it' translated.
+ 
  	aMenu add: 'reveal this object' translated target: player selector: #revealPlayerIn: argument: ActiveWorld.
+ 	aMenu balloonTextForLastItem: 'If you have misplaced the object bearing this script, use this item to (try to) make it visible' translated.
+ 
+ 	aMenu add: 'tile representing this object' translated target: player selector: #tearOffTileForSelf.
+ 	aMenu balloonTextForLastItem: 'choose this to obtain a tile which represents the object associated with this script' translated.
+ 
+ 	aMenu addLine.
+ 
- 	aMenu balloonTextForLastItem: 'Make certain this object is visible on the screen; flash its image for a little while, and give it the halo.' translated.
  	aMenu add: 'open this script''s Scriptor' translated target: player selector: #grabScriptorForSelector:in: argumentList: {selector. aStatusViewer world}.
  	aMenu balloonTextForLastItem: 'Open up the Scriptor for this script' translated.
  	aMenu add: 'open this object''s Viewer' translated target: player selector: #beViewed.
  	aMenu balloonTextForLastItem: 'Open up a Viewer for this object' translated.
  	aMenu addLine.
  	aMenu add: 'more...' translated target: self selector: #offerShiftedMenuIn: argument: aStatusViewer.
  	aMenu balloonTextForLastItem: 'The "more..." branch offers you menu items that are less frequently used.' translated.
  	aMenu popUpInWorld: ActiveWorld!

Item was added:
+ ----- Method: ScriptInstantiation>>resetTo:ifCurrently: (in category '*Etoys-Squeakland-status control') -----
+ resetTo: newStatus ifCurrently: aStatus
+ 	"If my status *had been* aStatus, quietly reset it to newStatus, without tampering with event handlers.  But get the physical display of all affected status morphs right"
+ 
+ 	status == aStatus ifTrue:
+ 		[status _ newStatus.
+ 		self updateAllStatusMorphs]!

Item was changed:
  ----- Method: ScriptInstantiation>>statusControlRowIn: (in category 'misc') -----
  statusControlRowIn: aStatusViewer
  	"Answer an object that reports my status and lets the user change it"
  
  	| aRow aMorph buttonWithPlayerName |
+ 	aRow _ ScriptStatusLine newRow beTransparent.
+ 	buttonWithPlayerName _ UpdatingSimpleButtonMorph new.
+ 	buttonWithPlayerName font: Preferences standardEToysButtonFont.
- 	aRow := ScriptStatusLine newRow beTransparent.
- 	buttonWithPlayerName := UpdatingSimpleButtonMorph new.
  	buttonWithPlayerName
  		on: #mouseEnter send: #menuButtonMouseEnter: to: buttonWithPlayerName;
  		 on: #mouseLeave send: #menuButtonMouseLeave: to: buttonWithPlayerName.
  
  	buttonWithPlayerName target: self; wordingSelector: #playersExternalName; actionSelector: #offerMenuIn:; arguments: {aStatusViewer}; beTransparent; actWhen: #buttonDown.
  	buttonWithPlayerName setBalloonText: 'This is the name of the player to which this script belongs; if you click here, you will get a menu of interesting options pertaining to this player and script' translated.
  	buttonWithPlayerName borderWidth: 1; borderColor: Color blue.
  	aRow addMorphBack: buttonWithPlayerName.
  	aRow addTransparentSpacerOfSize: 10 at 0.
  	aRow addMorphBack: AlignmentMorph newVariableTransparentSpacer.
  
+ 	aMorph _ UpdatingStringMorph on: self selector: #selector.
+ 	aMorph font: Preferences standardEToysButtonFont.
- 	aMorph := UpdatingStringMorph on: self selector: #selector.
  	aMorph color: Color brown lighter; useStringFormat.
  	aMorph setBalloonText: 'This is the name of the script to which this entry pertains.' translated.
  	aRow addMorphBack: aMorph.
  	aRow addMorphBack: AlignmentMorph newVariableTransparentSpacer.
  	aRow addTransparentSpacerOfSize: 10 at 0.
  
  	aRow addMorphBack: self statusControlMorph.
  	aRow submorphsDo: [:m | m wantsSteps ifTrue: [m step]].
  	^ aRow!

Item was added:
+ ----- Method: ScriptInstantiation>>statusLabel (in category '*Etoys-Squeakland-status control') -----
+ statusLabel
+ 	^self translatedStatus!

Item was changed:
  ----- Method: ScriptInstantiation>>typeInTickingRate (in category 'status control') -----
  typeInTickingRate
  	| reply aNumber |
+ 	reply _ FillInTheBlank request: 'Number of ticks per second: ' translated initialAnswer: self tickingRate printString.
- 	reply := UIManager default request: 'Number of ticks per second: ' translated initialAnswer: self tickingRate printString.
  
  	reply ifNotNil:
+ 		[aNumber _ reply asNumber.
- 		[aNumber := reply asNumber.
  		aNumber > 0 ifTrue:
  			[self tickingRate: aNumber]]!

Item was changed:
  ----- Method: ScriptInstantiation>>updateStatusMorph: (in category 'status control') -----
  updateStatusMorph: statusControlMorph
  	"the status control may need to reflect an externally-induced change in status"
  
  	| colorSelector statusReadoutButton |
  	statusControlMorph ifNil: [^ self].
  
  	self pausedOrTicking
  		ifTrue:
  			[statusControlMorph assurePauseTickControlsShow]
  		ifFalse:
  			[statusControlMorph maybeRemovePauseTickControls].
+ 	statusReadoutButton _ statusControlMorph submorphs last.
+ 	colorSelector _ ScriptingSystem statusColorSymbolFor: self status.
- 	statusReadoutButton := statusControlMorph submorphs last.
- 	colorSelector := ScriptingSystem statusColorSymbolFor: self status.
  	statusReadoutButton color: (Color perform: colorSelector) muchLighter.
+ 	statusReadoutButton label: self translatedStatus asString font: ScriptingSystem fontForEToyButtons!
- 	statusReadoutButton label: self translatedStatus asString font: Preferences standardButtonFont!

Item was changed:
  ----- Method: ScriptNameType>>defaultArgumentTile (in category 'tiles') -----
  defaultArgumentTile
  	"Answer a tile to represent the type"
  
  	| aTile  |
+ 	aTile _ ScriptNameTile new dataType: self vocabularyName.
- 	aTile := ScriptNameTile new dataType: self vocabularyName.
  	aTile addArrows.
+ 	'empty script' translatedNoop.
  	aTile setLiteral: #emptyScript.
  	^ aTile!

Item was added:
+ SimpleButtonMorph subclass: #ScriptOpeningButtonMorph
+ 	instanceVariableNames: 'affiliatedScriptor'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Buttons'!

Item was added:
+ ----- Method: ScriptOpeningButtonMorph>>affiliatedScriptor (in category 'accessing') -----
+ affiliatedScriptor
+ 	"Answer the affiliatedScriptor"
+ 
+ 	^ affiliatedScriptor!

Item was added:
+ ----- Method: ScriptOpeningButtonMorph>>affiliatedScriptor: (in category 'accessing') -----
+ affiliatedScriptor: aScriptor
+ 	"Set the value of affiliatedScriptor."
+ 
+ 	affiliatedScriptor := aScriptor!

Item was added:
+ ----- Method: ScriptOpeningButtonMorph>>bringUpToDate (in category 'as yet unclassified') -----
+ bringUpToDate
+ 	"The object's name, or the script name, or both, may have changed.  Make sure I continue to look and act right"
+ 
+ 	(self hasProperty: #labelManuallyEdited) ifFalse:
+ 		[self label: self standardLabelForButton].
+ 	self setBalloonText: ('show or hide the script named {1} in the object named {2} ' translated format: {affiliatedScriptor scriptName.  affiliatedScriptor playerScripted externalName}).!

Item was added:
+ ----- Method: ScriptOpeningButtonMorph>>isTileScriptingElement (in category 'accessing') -----
+ isTileScriptingElement
+ 	"Answer whether the receiver is a tile-scripting element."
+ 
+ 	^ true!

Item was added:
+ ----- Method: ScriptOpeningButtonMorph>>labelString: (in category 'accessing') -----
+ labelString: aString
+ 	"Set the labelString"
+ 
+ 	super labelString: aString.
+ 	self setProperty: #labelManuallyEdited toValue: true!

Item was added:
+ ----- Method: ScriptOpeningButtonMorph>>setLabelStringInitially: (in category 'accessing') -----
+ setLabelStringInitially: aString
+ 	"Set the labelString initially"
+ 
+ 	self labelString: aString.
+ 	self removeProperty: #labelManuallyEdited!

Item was added:
+ ----- Method: ScriptOpeningButtonMorph>>standardLabelForButton (in category 'as yet unclassified') -----
+ standardLabelForButton
+ 	"Answer a string to serve as a prospective label for the receiver."
+ 
+ 	^  affiliatedScriptor playerScripted externalName , ' ', affiliatedScriptor scriptName!

Item was added:
+ Parser subclass: #ScriptParser
+ 	instanceVariableNames: 'requestor'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Compiler'!

Item was added:
+ ----- Method: ScriptParser>>parse:class:noPattern:context:notifying:ifFail: (in category 'as yet unclassified') -----
+ parse: sourceStream class: class noPattern: noPattern context: ctxt notifying: req ifFail: aBlock 
+         "Answer a MethodNode for the argument, sourceStream, that is the root of 
+         a parse tree. Parsing is done with respect to the argument, class, to find 
+         instance, class, and pool variables; and with respect to the argument, 
+         ctxt, to find temporary variables. Errors in parsing are reported to the 
+         argument, req, if not nil; otherwise aBlock is evaluated. The argument 
+         noPattern is a Boolean that is true if the the sourceStream does not 
+         contain a method header (i.e., for DoIts)."
+ 
+ 	"Copied from superclass, use ScriptEncoder and give it a referenceWorld. This assumes worldLoading has been set to the right world this player belongs to. --bf 5/4/2010"
+ 
+          | methNode repeatNeeded myStream parser s p |
+         (req notNil and: [RequestAlternateSyntaxSetting signal and: [(sourceStream isKindOf: FileStream) not]])
+                 ifTrue: [parser _ self as: DialectParser]
+                 ifFalse: [parser _ self].
+         myStream _ sourceStream.
+         [repeatNeeded _ false.
+ 	   p _ myStream position.
+ 	   s _ myStream upToEnd.
+ 	   myStream position: p.
+         parser init: myStream notifying: req failBlock: [^ aBlock value].
+         doitFlag _ noPattern.
+         failBlock _ aBlock.
+         [methNode _ parser method: noPattern context: ctxt
+                                 encoder: (ScriptEncoder new init: class context: ctxt notifying: parser;
+ 								referenceObject: ActiveWorld referenceWorld )] 
+                 on: ParserRemovedUnusedTemps 
+                 do: 
+                         [ :ex | repeatNeeded _ (requestor isKindOf: TextMorphEditor) not.
+                         myStream _ ReadStream on: requestor text string.
+                         ex resume].
+         repeatNeeded] whileTrue.
+         encoder _ failBlock _ requestor _ parseNode _ nil. "break cycles & mitigate refct overflow"
+ 	   methNode sourceText: s.
+         ^ methNode!

Item was added:
+ ----- Method: ScriptParser>>parse:class:noPattern:context:notifying:ifFail:for: (in category 'as yet unclassified') -----
+ parse: sourceStream class: class noPattern: noPattern context: ctxt notifying: req ifFail: aBlock for: anInstance
+ 
+          | methNode repeatNeeded myStream parser s p |
+         (req notNil and: [RequestAlternateSyntaxSetting signal and: [(sourceStream isKindOf: FileStream) not]])
+                 ifTrue: [parser _ self as: DialectParser]
+                 ifFalse: [parser _ self].
+         myStream _ sourceStream.
+         [repeatNeeded _ false.
+ 	   p _ myStream position.
+ 	   s _ myStream upToEnd.
+ 	   myStream position: p.
+         parser init: myStream notifying: req failBlock: [^ aBlock value].
+         doitFlag _ noPattern.
+         failBlock _ aBlock.
+         [methNode _ parser method: noPattern context: ctxt
+                                 encoder: (ScriptEncoder new init: class context: ctxt notifying: parser;  referenceObject: (anInstance costume ifNotNil: [anInstance costume referenceWorld] ifNil: [ActiveWorld]))] 
+                 on: ParserRemovedUnusedTemps 
+                 do: 
+                         [ :ex | repeatNeeded _ (requestor isKindOf: TextMorphEditor) not.
+                         myStream _ ReadStream on: requestor text string.
+                         ex resume].
+         repeatNeeded] whileTrue.
+         encoder _ failBlock _ requestor _ parseNode _ nil. "break cycles & mitigate refct overflow"
+ 	   methNode sourceText: s.
+         ^ methNode!

Item was added:
+ ----- Method: ScriptParser>>removeUnusedTemps (in category 'as yet unclassified') -----
+ removeUnusedTemps
+ 	"doing nothing"!

Item was added:
+ ----- Method: ScriptParser>>requestor (in category 'accessing') -----
+ requestor
+ 
+ 	^ requestor!

Item was added:
+ ----- Method: ScriptParser>>requestor: (in category 'accessing') -----
+ requestor: anObject
+ 
+ 	requestor := anObject!

Item was added:
+ ----- Method: ScriptStatusControl>>fixUpScriptInstantiation (in category '*Etoys-Squeakland-access') -----
+ fixUpScriptInstantiation
+ 	"If the receiver's scriptInstantiation is broken (owing to a bug also fixed in the update housing this code) fix it up and reply true, else reply false."
+ 
+ 	| myPlayer correctInstantiation result |
+ 	myPlayer := scriptInstantiation player.
+ 	correctInstantiation := myPlayer scriptInstantiationForSelector: scriptInstantiation selector.
+ 	result := correctInstantiation ~~ scriptInstantiation.
+ 	result
+ 		ifTrue:
+ 			[self removeAllMorphs.
+ 			tickPauseWrapper := nil.
+ 			tickPauseButtonsShowing := false.
+ 			self initializeFor: correctInstantiation].
+ 	^ result!

Item was changed:
  ----- Method: ScriptStatusControl>>initializeFor: (in category 'initialization') -----
  initializeFor: aScriptInstantiation
  	"Answer a control that will serve to reflect and allow the user to change the status of the receiver"
  
  	|  statusReadout |
  	self hResizing: #shrinkWrap.
+ 	self vResizing: #shrinkWrap.
+ 	self cellInset: 0 at 0.
+ 	self layoutInset: 0.
+ 	scriptInstantiation _ aScriptInstantiation.
+ 	tickPauseButtonsShowing _ false.
- 	self cellInset: 2 at 0.
- 	scriptInstantiation := aScriptInstantiation.
- 	tickPauseButtonsShowing := false.
  
+ 	self addMorphBack: (statusReadout _ UpdatingSimpleButtonMorph new).
+ 	statusReadout label: aScriptInstantiation status asString font: ScriptingSystem fontForEToyButtons.
- 	self addMorphBack: (statusReadout := UpdatingSimpleButtonMorph new).
- 	statusReadout label: aScriptInstantiation status asString font: Preferences standardButtonFont.
  	statusReadout setNameTo: 'trigger'.
+ 	statusReadout height: statusReadout height - 4.
+ 	statusReadout vResizing: #rigid.
+ 
  	statusReadout target: aScriptInstantiation; wordingSelector: #translatedStatus; actionSelector: #presentScriptStatusPopUp.
  	statusReadout setBalloonText: 'when this script should run' translated.
  	statusReadout actWhen: #buttonDown.
  
  	self assurePauseTickControlsShow.
  	aScriptInstantiation updateStatusMorph: self!

Item was changed:
  ----- Method: ScriptStatusControl>>mouseUpTick:onItem: (in category 'mouse gestures') -----
  mouseUpTick: evt onItem: aMorph
  	self removeAlarm: #offerTickingMenu:.
+ 	(self ownerThatIsA: ScriptEditorMorph) ifNotNil:[ :i | i deleteEtoysDebugger].
  	aMorph color: (Color r: 0.767 g: 0.767 b: 1.0).
  	(scriptInstantiation status == #ticking) ifTrue:[
  		scriptInstantiation status: #paused. 
  		aMorph color: (Color r: 1.0 g: 0.774 b: 0.774).
  		aMorph isTicking: false.
  	] ifFalse:[
  		scriptInstantiation status: #ticking. 
  		aMorph color: (Color r: 0.767 g: 0.767 b: 1.0).
  		aMorph isTicking: true.
  	].
  	scriptInstantiation updateAllStatusMorphs.!

Item was changed:
  ----- Method: ScriptableButton class>>defaultNameStemForInstances (in category 'printing') -----
  defaultNameStemForInstances
  	"Answer the default name stem to use for instances of the receiver"
  
+ 	^ 'button' translatedNoop!
- 	^ 'button'!

Item was changed:
  ----- Method: ScriptableButton class>>descriptionForPartsBin (in category 'name') -----
  descriptionForPartsBin
+ 	"Answer a description for use in bulding parts bins.  In latest take, this is not seen in any explicit category, but rather only in alphabetic or 'find' retrievals."
+ 
+ 	^ self partName:	'Button' translatedNoop
+ 		categories:		{'Scripting' translatedNoop. }
+ 		documentation:	'A button to use with tile scripting; its script will be a method of its containing playfield' translatedNoop!
- 	^ self partName:	'Button'
- 		categories:		#('Scripting' 'Basic')
- 		documentation:	'A button to use with tile scripting; its script will be a method of its containing playfield'!

Item was changed:
  ----- Method: ScriptableButton class>>registerInFlapsRegistry (in category 'class initialization') -----
  registerInFlapsRegistry
  	"Register the receiver in the system's flaps registry"
  	self environment
  		at: #Flaps
+ 		ifPresent: [:cl | cl registerQuad: {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}
- 		ifPresent: [:cl | cl registerQuad: #(ScriptableButton		authoringPrototype	'Button' 		'A Scriptable button')
  						forFlapNamed: 'PlugIn Supplies'.
+ 						cl registerQuad: {#ScriptableButton. #authoringPrototype.	'Button' translatedNoop. 	'A Scriptable button' translatedNoop}
- 						cl registerQuad: #(ScriptableButton		authoringPrototype	'Button' 		'A Scriptable button')
  						forFlapNamed: 'Scripting'.
+ 						cl registerQuad: {#ScriptableButton. #authoringPrototype. 'Scriptable Button' translatedNoop. 'A button whose script will be a method of the background Player' translatedNoop}
- 						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' translatedNoop. 'A Scriptable button' translatedNoop}
- 						cl registerQuad: #(ScriptableButton		authoringPrototype	'Button' 		'A Scriptable button')
  						forFlapNamed: 'Supplies'.]!

Item was changed:
  ----- Method: ScriptableButton>>editButtonsScript (in category 'script') -----
  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) 
- 					[(cardsPlayer class includesSelector: 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!

Item was changed:
  ----- Method: ScriptableButton>>label: (in category 'accessing') -----
  label: aString
  	"Set the receiver's label as indicated"
  
  	| aLabel |
+ 	(aLabel _ self findA: StringMorph)
- 	(aLabel := self findA: StringMorph)
  		ifNotNil:
  			[aLabel contents: aString]
  		ifNil:
+ 			[aLabel _ StringMorph contents: aString font: Preferences standardEToysButtonFont.
- 			[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!

Item was changed:
  ----- Method: ScriptableButton>>setLabel (in category 'menu') -----
  setLabel
  	"Invoked from a menu, let the user change the label of the button"
  
  	| newLabel |
+ 	newLabel _ FillInTheBlank
- 	newLabel := UIManager default
  		request:
+ 'Enter a new label for this button' translated
- 'Enter a new label for this button'
  		initialAnswer: self label.
  	newLabel isEmpty ifFalse: [self label: newLabel font: nil].
  !

Item was added:
+ AlignmentMorph subclass: #ScriptingTileHolder
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Scripting Tiles'!
+ 
+ !ScriptingTileHolder commentStamp: 'sw 6/28/2007 17:18' prior: 0!
+ Serves as a wrapper for a scripting-tile element that otherwise would be bare on the desktop.!

Item was added:
+ ----- Method: ScriptingTileHolder class>>around: (in category 'instance creation') -----
+ around: aTile
+ 	"Answer a new instance of the receiver, surrounding the given tile."
+ 
+ 	^ self new around: aTile!

Item was added:
+ ----- Method: ScriptingTileHolder>>around: (in category 'initialization') -----
+ around: aTileScriptingElement
+ 	"Make the receiver surround the given item, either a TileMorph or a PhraseTileMorph or something like a CompoundTIleMorph."
+ 
+ 	self removeAllMorphs.
+ 	self position: aTileScriptingElement position.
+ 	self addMorph: aTileScriptingElement.
+ 	aTileScriptingElement lock.
+ !

Item was added:
+ ----- Method: ScriptingTileHolder>>fixLayout (in category 'initialization') -----
+ fixLayout
+ 
+ 	self allMorphsDo: [:m | m fixLayoutOfSubmorphs].
+ !

Item was added:
+ ----- Method: ScriptingTileHolder>>handlesMouseDown: (in category 'mouse handling') -----
+ handlesMouseDown: evt
+ 	"Do I want to receive mouseDown events (mouseDown:, mouseMove:, mouseUp:)?"
+ 
+ 	^ true!

Item was added:
+ ----- Method: ScriptingTileHolder>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 
+ 	super initialize.
+ 	self hResizing: #shrinkWrap;
+ 		vResizing: #shrinkWrap;
+ 		borderWidth: 3;
+ 		borderColor: Color green muchDarker;
+ 		cellInset: 0; layoutInset: 0!

Item was added:
+ ----- Method: ScriptingTileHolder>>localeChanged (in category 'initialization') -----
+ localeChanged
+ 
+ 	self fixLayout.
+ !

Item was added:
+ ----- Method: ScriptingTileHolder>>mouseDown: (in category 'mouse handling') -----
+ mouseDown: evt
+ 	"Handle a mouse-down event."
+ 
+ 	| actualTile |
+ 	actualTile := submorphs at: 1 ifAbsent: [^ self delete].  "Not expected to happen."
+ 	actualTile unlock.
+ 	self topRendererOrSelf delete.
+ 	evt hand grabMorph: actualTile!

Item was added:
+ ----- Method: ScriptingTileHolder>>unhibernate (in category 'initialization') -----
+ unhibernate
+ 
+ 	self fixLayout.
+ !

Item was added:
+ ----- Method: ScrollBar>>hideMenuButton (in category '*Etoys-Squeakland-access') -----
+ hideMenuButton
+ 
+ 	self setProperty: #withMenuButton toValue: false.
+ 	menuButton _ nil.
+ 	self removeAllMorphs; initializeSlider.
+ !

Item was added:
+ ----- Method: ScrollBar>>showMenuButton (in category '*Etoys-Squeakland-access') -----
+ showMenuButton
+ 
+ 	self setProperty: #withMenuButton toValue: true.
+ 	self removeAllMorphs; initializeSlider.
+ !

Item was added:
+ ----- Method: ScrollPane>>hideMenuButton (in category '*Etoys-Squeakland-menu') -----
+ hideMenuButton
+ 
+ 	self setProperty: #withMenuButton toValue: false.
+ 	scrollBar ifNotNil: [
+ 		scrollBar setProperty: #withMenuButton toValue: false.
+ 		scrollBar hideMenuButton.
+ 	].
+ 	hScrollBar ifNotNil: [
+ 		hScrollBar setProperty: #withMenuButton toValue: false.
+ 		hScrollBar hideMenuButton.
+ 	].
+ !

Item was added:
+ ----- Method: ScrollPane>>scrollHorizontallyToShow: (in category '*Etoys-Squeakland-access') -----
+ scrollHorizontallyToShow: aRectangle
+ 	"scroll horizontally to include as much of aRectangle as possible, where aRectangle is in the scroller's local space"
+ 
+ 	| range |
+ 	((aRectangle left - scroller offset x) >= 0 and:
+ 		[(aRectangle right - scroller offset x) <= (self innerBounds width) ])
+ 		ifTrue:[ "already visible" ^self ].
+ 
+ 	range _ self hLeftoverScrollRange.
+ 	hScrollBar value: (range > 0
+ 		ifTrue: [((aRectangle left) / self hLeftoverScrollRange)
+ 							truncateTo: hScrollBar scrollDelta]
+ 		ifFalse: [0]).
+ 	scroller offset:  (range * hScrollBar value) @  -3.
+ !

Item was added:
+ ----- Method: ScrollPane>>showMenuButton (in category '*Etoys-Squeakland-menu') -----
+ showMenuButton
+ 
+ 	self setProperty: #withMenuButton toValue: true.
+ 	scrollBar ifNotNil: [scrollBar showMenuButton].
+ 	hScrollBar ifNotNil: [hScrollBar showMenuButton].
+ !

Item was added:
+ ----- Method: ScrollableField>>spawn: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ spawn: aByteString 
+ 	"Hack to open the object catalog when Cmd-O is pressed"
+ 	self setMyText: aByteString.
+ 	(World commandKeySelectors at: $o) value.
+ !

Item was added:
+ ----- Method: ScrollingToolHolder>>isEmpty (in category '*Etoys-Squeakland-as yet unclassified') -----
+ isEmpty
+ 	"Return true if there are no stamps"
+ 	^ stamps allSatisfy: [:ss | ss == nil]!

Item was added:
+ ----- Method: ScrollingToolHolder>>stamps (in category '*Etoys-Squeakland-as yet unclassified') -----
+ stamps
+ 	^ stamps!

Item was added:
+ ----- Method: ScrollingToolHolder>>stamps: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ stamps: anOrderedCollection
+ 	stamps _ anOrderedCollection!

Item was added:
+ ----- Method: ScrollingToolHolder>>thumbnailPics (in category '*Etoys-Squeakland-as yet unclassified') -----
+ thumbnailPics
+ 	^ thumbnailPics!

Item was added:
+ ----- Method: ScrollingToolHolder>>thumbnailPics: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ thumbnailPics: oc
+ 	thumbnailPics _ oc!

Item was changed:
  ----- Method: SearchingViewer>>addNamePaneTo: (in category 'initialization') -----
  addNamePaneTo: header
  	"Add the namePane, which may be a popup or a type-in depending on the type of CategoryViewer"
  
+ 	| searchButton aStringMorph aBox |
+ 	namePane _ AlignmentMorph newRow vResizing: #spaceFill; height: 14.
+ 	namePane color: Color transparent.
- 	| plugTextMor searchButton |
- 	namePane := AlignmentMorph newRow vResizing: #spaceFill; height: 14.
  	namePane hResizing: #spaceFill.
  	namePane listDirection: #leftToRight.
+ 	aBox := PasteUpMorph new.
+ 	aBox beTransparent.
+ 	aBox beSticky.
+ 	aBox hResizing: #spaceFill; vResizing: #rigid; height: Preferences standardEToysFont height.
+ 	aBox borderWidth: 1; borderColor: Color gray.
+ 	aStringMorph := UpdatingStringMorph new.
+ 	aStringMorph useStringFormat.
+ 	aStringMorph target: self; getSelector: #searchString; putSelector: #searchString:notifying:.
+ 	aStringMorph hResizing: #spaceFill.
+ 	aStringMorph height: Preferences standardEToysFont height rounded; vResizing: #rigid.
+ 	aStringMorph stepTime: 5000.
+ 	aStringMorph font: Preferences standardEToysFont.
+ 	aBox addMorphBack: aStringMorph.
+ 	aBox on: #mouseDown send: #mouseDown: to: aStringMorph.
+ 	aStringMorph topLeft: (aBox topLeft + (3 at 0)).
  
+ 	searchButton _ SimpleButtonMorph new 
- 	plugTextMor := PluggableTextMorph on: self
- 					text: #searchString accept: #searchString:notifying:
- 					readSelection: nil menu: nil.
- 	plugTextMor setProperty: #alwaysAccept toValue: true.
- 	plugTextMor askBeforeDiscardingEdits: false.
- 	plugTextMor acceptOnCR: true.
- 	plugTextMor setTextColor: Color brown.
- 	plugTextMor setNameTo: 'Search' translated.
- 	plugTextMor vResizing: #spaceFill; hResizing: #spaceFill.
- 	plugTextMor hideScrollBarsIndefinitely.
- 	plugTextMor setTextMorphToSelectAllOnMouseEnter.
- 
- 	searchButton := SimpleButtonMorph new 
  		target: self;
  		beTransparent;
  		actionSelector: #doSearchFrom:;
+ 		arguments: {aStringMorph}.
+ 	searchButton setBalloonText: 'Type some letters into the pane at right, and then press this Search button (or hit RETURN) and all tiles that match what you typed will appear in the list below.' translated.
- 		arguments: {plugTextMor}.
  
  	namePane addMorphFront: searchButton.
  	namePane addTransparentSpacerOfSize: 6 at 0.
+ 	namePane addMorphBack: aBox.
- 	namePane addMorphBack: plugTextMor.
  	header addMorphBack: namePane.
  	self updateSearchButtonLabel.!

Item was changed:
  ----- Method: SearchingViewer>>doSearchFrom:interactive: (in category 'search') -----
+ doSearchFrom: aSource interactive: isInteractive
- doSearchFrom:  aSource interactive: isInteractive
  	"Perform the search operation.  If interactive is true, this actually happened because a search button was pressed; if false, it was triggered some other way for which an informer would be inappropriate."
  
+ 	| searchFor aVocab aList all anInterface useTranslations scriptNames addedMorphs |
+ 
+ 	searchString := aSource isString
- 	| searchFor aVocab aList all useTranslations scriptNames addedMorphs |
- 	searchString := (aSource isKindOf: PluggableTextMorph)
- 		ifFalse:
- 			[aSource]
  		ifTrue:
+ 			[aSource]
+ 		ifFalse:
+ 			[(aSource isKindOf: PluggableTextMorph) "old"
+ 				ifTrue:
+ 					[aSource text string]
+ 				ifFalse:
+ 					[aSource contents asString]].
+ 	searchFor _ searchString asLowercaseAlphabetic.
- 			[aSource text string].
- 	searchFor := searchString asString asLowercase withBlanksTrimmed.
  
+ 	aVocab _ self outerViewer currentVocabulary.
+ 	(useTranslations _ (scriptedPlayer isPlayerLike) and: [aVocab isEToyVocabulary])
- 	aVocab := self outerViewer currentVocabulary.
- 	(useTranslations := (scriptedPlayer isPlayerLike) and: [aVocab isEToyVocabulary])
  		ifTrue:
+ 			[all _ scriptedPlayer costume selectorsForViewer.
+ 			all addAll: (scriptNames _ scriptedPlayer class namedTileScriptSelectors)]
- 			[all := scriptedPlayer costume selectorsForViewer.
- 			all addAll: (scriptNames := scriptedPlayer class namedTileScriptSelectors)]
  		ifFalse:
+ 			[all _ scriptNames _ scriptedPlayer class allSelectors].
+ 	aList _ all select:
+ 		[:aSelector | (aVocab includesSelector: aSelector forInstance: scriptedPlayer ofClass: scriptedPlayer class limitClass: ProtoObject) and:
+ 			[(useTranslations and: [(anInterface _ aVocab methodInterfaceAt: aSelector ifAbsent: [nil]) notNil and: [anInterface wording asString asLowercaseAlphabetic includesSubstring: searchFor caseSensitive: true]])
- 			[all := scriptNames := scriptedPlayer class allSelectors].
- 	aList := all select:
- 		[:aSelector | | anInterface |
- 		(aVocab includesSelector: aSelector forInstance: scriptedPlayer ofClass: scriptedPlayer class limitClass: ProtoObject) and:
- 			[(useTranslations and: [(anInterface := aVocab methodInterfaceAt: aSelector ifAbsent: [nil]) notNil and: [anInterface wording includesSubstring: searchFor caseSensitive: false]])
  				or:
  					[((scriptNames includes: aSelector) or: [useTranslations not]) and:
  						[aSelector includesSubstring: searchFor caseSensitive: false]]]].
+ 	aList _ aList asSortedArray.
- 	aList := aList asSortedArray.
  
  	self removeAllButFirstSubmorph. "that being the header"
  	self addAllMorphs:
+ 		((addedMorphs _ scriptedPlayer tilePhrasesForSelectorList: aList inViewer: self)).
- 		((addedMorphs := scriptedPlayer tilePhrasesForSelectorList: aList inViewer: self)).
  	self enforceTileColorPolicy.
  	self secreteCategorySymbol.
  	self world ifNotNil: [self world startSteppingSubmorphsOf: self].
  	self adjustColorsAndBordersWithin.
  
  	owner ifNotNil: [owner isStandardViewer ifTrue: [owner fitFlap].
  
  	(isInteractive and: [addedMorphs isEmpty]) ifTrue:
+ 		[searchFor ifNotEmpty:
+ 			[self inform: ('No matches found for "' translated), searchFor, '"']]]!
- 		[self inform: ('No matches found for "' translated), searchFor, '"']]!

Item was changed:
  ----- Method: SearchingViewer>>initializeFor:categoryChoice: (in category 'initialization') -----
  initializeFor: aPlayer categoryChoice: aChoice
+ 	"Initialize the receiver to be associated with the player and category specified."
- 	"Initialize the receiver to be associated with the player and category specified"
  
+ 	| itsContents |
  	super initializeFor: aPlayer categoryChoice: #search.
  	self clipSubmorphs: true.
+ 	itsContents := aChoice second.
+ 	itsContents ifEmpty: [itsContents := '    '].
+ 	(namePane submorphs last findA: UpdatingStringMorph) contents: itsContents.
+ 
- 	(namePane findA: PluggableTextMorph) setText: aChoice second asText.
  	self setCategorySymbolFrom: aChoice!

Item was changed:
  ----- Method: SearchingViewer>>updateCategoryNameTo: (in category 'categories') -----
  updateCategoryNameTo: aName
  	"Update the category name, because of a language change."
  
+ 	self doSearchFrom: (namePane findDeeplyA: UpdatingStringMorph) contents interactive: false.
- 	self doSearchFrom: (namePane findA: PluggableTextMorph) text interactive: false.
  	self updateSearchButtonLabel
  !

Item was changed:
  ----- Method: SearchingViewer>>updateSearchButtonLabel (in category 'categories') -----
  updateSearchButtonLabel
+ 	"Update the label on the search button."
+ 
  	| button |
  	button := self
  				findDeepSubmorphThat: [:e | e class = SimpleButtonMorph]
  				ifAbsent: [].
+ 	button label: 'Search' translated  font: ScriptingSystem fontForEToyButtons.
+ 	button setBalloonText: 'Type some letters into the pane at right, and then press this Search button (or hit RETURN) and all tiles that match what you typed will appear in the list below.' translated!
- 	button label: 'Search' translated.
- 	button setBalloonText: 'Type some letters into the pane at right, and then press this Search button (or hit RETURN) and all method selectors that match what you typed will appear in the list below.' translated!

Item was added:
+ PolygonMorph subclass: #SectorMorph
+ 	instanceVariableNames: 'angle'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-MorphicExtras-AdditionalMorphs'!

Item was added:
+ ----- Method: SectorMorph class>>additionsToViewerCategories (in category 'viewer categories') -----
+ additionsToViewerCategories
+ 	"Answer additions to viewer categories."
+ 
+ 	^ #((basic
+ 			((slot angle 'the angle, in degrees, at the vertex of the sector' Number readWrite Player getSectorAngle Player setSectorAngle:)
+ 			(slot radius 'length of a radius of the sector' Number readWrite Player getSectorRadius Player setSectorRadius:)))
+ 
+ 		(sector
+ 			((slot angle 'the angle, in degrees, at the vertex of the sector' Number readWrite Player getSectorAngle Player setSectorAngle:)
+ 			(slot radius 'length of a radius of the sector' Number readWrite Player getSectorRadius Player setSectorRadius:)
+ 			(slot showingHandles 'Whether the handles are showing' Boolean readWrite Player getShowingHandles  Player setShowingHandles:)
+ )))!

Item was added:
+ ----- Method: SectorMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self
+ 		partName: 'Sector' translatedNoop
+ 		categories: {'Graphics' translatedNoop}
+ 		documentation: 'A sector tool that lets you create slices of a pie of any angle for applications like fractions or drawing' translatedNoop!

Item was added:
+ ----- Method: SectorMorph>>addCustomMenuItems:hand: (in category 'menu & halo') -----
+ addCustomMenuItems: aMenu hand: aHandMorph 
+ 	aMenu
+ 		addUpdating: #handlesShowingPhrase
+ 		target: self
+ 		action: #showOrHideHandles!

Item was added:
+ ----- Method: SectorMorph>>addHandles (in category 'editing') -----
+ addHandles
+ 	| handle |
+ 	self removeHandles.
+ 	handle := EllipseMorph
+ 				newBounds: (Rectangle center: vertices last extent: 16 @ 16)
+ 				color: Color yellow.
+ 	handle
+ 		on: #mouseMove
+ 		send: #dragEvent:fromHandle:
+ 		to: self.
+ 	handle
+ 		on: #mouseUp
+ 		send: #dropEvent:fromHandle:
+ 		to: self.
+ 	self addMorph: handle.
+ 	handles := {handle}.
+ 	self changed!

Item was added:
+ ----- Method: SectorMorph>>angle (in category 'accessing') -----
+ angle
+ 	^ angle!

Item was added:
+ ----- Method: SectorMorph>>angle: (in category 'accessing') -----
+ angle: aNumber 
+ 	angle = aNumber
+ 		ifTrue: [^ self].
+ 	angle := aNumber \\ 361.
+ 	self update!

Item was added:
+ ----- Method: SectorMorph>>computeBounds (in category 'updating') -----
+ computeBounds
+ 	super computeBounds.
+ 	self setRotationCenterFrom: vertices first!

Item was added:
+ ----- Method: SectorMorph>>dragEvent:fromHandle: (in category 'event handling') -----
+ dragEvent: evt fromHandle: morph 
+ 	self angle: (evt position - vertices first * (1 @ -1)) degrees + self heading!

Item was added:
+ ----- Method: SectorMorph>>dropEvent:fromHandle: (in category 'event handling') -----
+ dropEvent: evt fromHandle: morph 
+ 	self flag: #Richo!

Item was added:
+ ----- Method: SectorMorph>>extent: (in category 'accessing') -----
+ extent: newExtent 
+ 	self radius: (newExtent x max: newExtent y)
+ 			/ 2!

Item was added:
+ ----- Method: SectorMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	angle := 45.
+ 	super initialize.
+ 	self initializeVertices; computeBounds!

Item was added:
+ ----- Method: SectorMorph>>initializeVertices (in category 'initialization') -----
+ initializeVertices
+ 	vertices := Array new: 50 withAll: 0 @ 0.
+ 	vertices at: 1 put: bounds bottomLeft;
+ 		 at: 2 put: bounds bottomRight.
+ 	self updateVertices!

Item was added:
+ ----- Method: SectorMorph>>radius (in category 'accessing') -----
+ radius
+ 	^ vertices first dist: vertices second!

Item was added:
+ ----- Method: SectorMorph>>radius: (in category 'accessing') -----
+ radius: aNumber 
+ 	| v1 v2 dx dy ang dx2 dy2 |
+ 	self radius = aNumber
+ 		ifTrue: [^ self].
+ 	v1 := vertices first.
+ 	v2 := vertices second.
+ 	dx := v2 x - v1 x.
+ 	dx = 0
+ 		ifTrue: [dx := 0.0001].
+ 	dy := v2 y - v1 y.
+ 	ang := (dy / dx) arcTan.
+ 	(dx eToysLT: 0)
+ 		ifTrue: [(dy eToysGT: 0)
+ 				ifTrue: [ang:= ang + 3.1416]].
+ 	(dx eToysLT: 0)
+ 		ifTrue: [(dy eToysLT: 0)
+ 				ifTrue: [ang:= ang + 3.1416]].
+ 	dx2 := ang cos * aNumber.
+ 	dy2 := ang sin * aNumber.
+ 	vertices at: 2 put: v1 + (dx2 @ dy2).
+ 	self update!

Item was added:
+ ----- Method: SectorMorph>>update (in category 'updating') -----
+ update
+ 	self updateVertices; updateHandles; computeBounds!

Item was added:
+ ----- Method: SectorMorph>>updateHandles (in category 'updating') -----
+ updateHandles
+ 	| ign |
+ 	(ign := handles)
+ 		ifNotNil: [handles first center: vertices last]!

Item was added:
+ ----- Method: SectorMorph>>updateVertices (in category 'updating') -----
+ updateVertices
+ 	| nSegments sin cos xn yn xn1 yn1 |
+ 	nSegments := vertices size - 2.
+ 	sin := (angle / nSegments * (2 * Float pi / 360.0)) sin.
+ 	cos := (angle / nSegments * (2 * Float pi / 360.0)) cos.
+ 	xn := vertices second x - vertices first x.
+ 	yn := vertices second y - vertices first y.
+ 	3
+ 		to: vertices size
+ 		do: [:i | 
+ 			xn1 := xn * cos + (yn * sin).
+ 			yn1 := yn * cos - (xn * sin).
+ 			vertices at: i put: vertices first + (xn1 @ yn1).
+ 			xn := xn1.
+ 			yn := yn1]!

Item was added:
+ ----- Method: SecurityManager>>asn1Integer: (in category '*Etoys-Squeakland-fileIn/out') -----
+ asn1Integer: aStream
+ 
+ 	| length integer |
+ 	aStream next = 2 ifFalse: [^self error: 'ASN.1 Integer tag expected'].
+ 	length := self asn1Length: aStream.
+ 	integer := Integer new: length neg: false.
+ 	length to: 1 by: -1 do: [:index |
+ 		integer digitAt: index put: aStream next].
+ 	((integer digitAt: length) > 127)
+ 		ifTrue: [integer := integer twosComplement negated].
+ 	^integer normalize.
+ !

Item was added:
+ ----- Method: SecurityManager>>asn1Length: (in category '*Etoys-Squeakland-fileIn/out') -----
+ asn1Length: aStream
+ 
+ 	^(aStream peek noMask: 16r80)
+ 		ifTrue: [aStream next]
+ 		ifFalse: [(aStream next: (aStream next bitAnd: 16r7F))
+ 			inject: 0
+ 			into: [:total :byte | total * 16r100 + byte]]
+ !

Item was added:
+ ----- Method: SecurityManager>>loadOLPCOwnerKey (in category '*Etoys-Squeakland-fileIn/out') -----
+ loadOLPCOwnerKey
+ 	"Load the OLPC owner's keys from Sugar's profile directory"
+ 	"SecurityManager default loadOLPCOwnerKey"
+ 	| fd loc key asn1 p q g y x |
+ 	self isInRestrictedMode ifTrue:[^self]. "no point in even trying"
+ 	loc := self secureUserDirectory, '/../../../'. "get it from the sugar profile directory"
+ 	fd := FileDirectory on: loc.
+ 	[key := (fd readOnlyFileNamed: 'owner.key') contentsOfEntireFile readStream]
+ 			on: FileDoesNotExistException do: [:ex| ^self].
+ 	(key upTo: Character lf) = '-----BEGIN DSA PRIVATE KEY-----'	ifFalse: [^self].
+ 	[
+ 		asn1 := Base64MimeConverter mimeDecodeToBytes: key upToEnd readStream.
+ 		asn1 next = 48 ifFalse: [self error: 'ASN.1 sequence tag expected'].
+ 		self asn1Length: asn1. "skip length of sequence"
+ 		self asn1Integer: asn1. 	"ignore first number which is 0" 
+ 		p := self asn1Integer: asn1.
+ 		q := self asn1Integer: asn1.
+ 		g := self asn1Integer: asn1.
+ 		y := self asn1Integer: asn1.
+ 		x := self asn1Integer: asn1.
+ 	] on: Error do: [:ex | ^self].
+ 	privateKeyPair := {{p. q. g. x}. {p. q. g. y}}
+ !

Item was added:
+ FormInput subclass: #SelectionInput
+ 	instanceVariableNames: 'name defaultValue listMorph values'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Forms'!
+ 
+ !SelectionInput commentStamp: '<historical>' prior: 0!
+ allows a user to select from a number of options!

Item was added:
+ ----- Method: SelectionInput class>>name:defaultValue:list:values: (in category 'instance creation') -----
+ name: name0  defaultValue: defaultValue  list: list  values: values
+ 	^self new name: name0  defaultValue: defaultValue  list: list  values: values!

Item was added:
+ ----- Method: SelectionInput>>active (in category 'handling input') -----
+ active
+ 	^self name isNil not and: [listMorph getCurrentSelectionIndex > 0]!

Item was added:
+ ----- Method: SelectionInput>>name (in category 'handling input') -----
+ name
+ 	^name!

Item was added:
+ ----- Method: SelectionInput>>name:defaultValue:list:values: (in category 'private-initialization') -----
+ name: name0  defaultValue: defaultValue0  list: list0 values: values0
+ 	name _ name0.
+ 	defaultValue _ defaultValue0.
+ 	listMorph _ list0.
+ 	values _ values0.!

Item was added:
+ ----- Method: SelectionInput>>reset (in category 'handling input') -----
+ reset
+ 	listMorph selection: defaultValue!

Item was added:
+ ----- Method: SelectionInput>>value (in category 'handling input') -----
+ value
+ 	^values at: listMorph getCurrentSelectionIndex!

Item was added:
+ ----- Method: SelectorNode>>defaultBlockType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultBlockType: t1 
+ 	^ #default!

Item was added:
+ ----- Method: SelectorNode>>defaultMessageType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultMessageType
+ 	^ #none!

Item was added:
+ ----- Method: SelectorNode>>emit:args:on: (in category '*Etoys-Squeakland-code generation') -----
+ emit: stack args: nArgs on: strm
+ 
+ 	self emit: stack
+ 		args: nArgs
+ 		on: strm
+ 		super: false!

Item was added:
+ ----- Method: SelectorNode>>emit:args:on:super: (in category '*Etoys-Squeakland-code generation') -----
+ emit: stack args: nArgs on: aStream super: supered
+ 	| index |
+ 	stack pop: nArgs.
+ 	(supered not and: [code - Send < SendLimit and: [nArgs < 3]]) ifTrue:
+ 		["short send"
+ 		code < Send
+ 			ifTrue: [^ aStream nextPut: code "special"]
+ 			ifFalse: [^ aStream nextPut: nArgs * 16 + code]].
+ 	index _ code < 256 ifTrue: [code - Send] ifFalse: [code \\ 256].
+ 	(index <= 31 and: [nArgs <= 7]) ifTrue: 
+ 		["extended (2-byte) send [131 and 133]"
+ 		aStream nextPut: SendLong + (supered ifTrue: [2] ifFalse: [0]).
+ 		^ aStream nextPut: nArgs * 32 + index].
+ 	(supered not and: [index <= 63 and: [nArgs <= 3]]) ifTrue:
+ 		["new extended (2-byte) send [134]"
+ 		aStream nextPut: SendLong2.
+ 		^ aStream nextPut: nArgs * 64 + index].
+ 	"long (3-byte) send"
+ 	aStream nextPut: DblExtDoAll.
+ 	aStream nextPut: nArgs + (supered ifTrue: [32] ifFalse: [0]).
+ 	aStream nextPut: index!

Item was added:
+ ----- Method: SelectorNode>>firstInReceivers: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ firstInReceivers: t1 
+ 	^ t1 first!

Item was added:
+ ----- Method: SelectorNode>>initialNil (in category '*Etoys-Tweak-Kedama-Generated') -----
+ initialNil
+ 	^ nil!

Item was added:
+ ----- Method: SelectorNode>>isStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isStmt: t1 
+ 	^ t1 = #top
+ 		or: [t1 = #condition]!

Item was added:
+ ----- Method: SelectorNode>>isTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTest: t1 parentNode: t2 
+ 	t1
+ 		ifTrue: [^ true].
+ 	^ (t2 isMemberOf: MessageNode)
+ 		and: [t2 receiver = self
+ 				and: [t2 messageType value = #condition]]!

Item was added:
+ ----- Method: SelectorNode>>isTopStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmt: t1 
+ 	t1 = nil
+ 		ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: SelectorNode>>precedence (in category '*Etoys-Squeakland-code generation') -----
+ precedence
+ 
+ 	^ key precedence!

Item was added:
+ ----- Method: SelectorNode>>rcvr: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr: t1 
+ 	^ t1!

Item was added:
+ ----- Method: SelectorNode>>thisNode (in category '*Etoys-Tweak-Kedama-Generated') -----
+ thisNode
+ 	^ self!

Item was added:
+ ----- Method: SelectorNode>>transfer: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 
+ 	^ t1!

Item was added:
+ ----- Method: SequenceableCollection>>customizeExplorerContents (in category '*Etoys-Squeakland-accessing') -----
+ customizeExplorerContents
+ 
+ 	^ true.
+ !

Item was added:
+ ----- Method: SequentialSound>>isCompressed (in category '*Etoys-Squeakland-accessing') -----
+ isCompressed
+ 	^ sounds size > 0
+ 		and: [sounds first isCompressed]!

Item was added:
+ ----- Method: ServerDirectory class>>addLocalProjectDirectoryFromPrefs: (in category '*Etoys-Squeakland-available servers') -----
+ addLocalProjectDirectoryFromPrefs: aFileDirectory
+ 	self prefsLocalProjectDirectories add: aFileDirectory
+ !

Item was added:
+ ----- Method: ServerDirectory class>>addServerFromPrefs:named: (in category '*Etoys-Squeakland-available servers') -----
+ addServerFromPrefs: server named: nameString
+ 	self prefsServers at: nameString put: server!

Item was added:
+ ----- Method: ServerDirectory class>>cleanupNonEssentialServerEntries (in category '*Etoys-Squeakland-olpc') -----
+ cleanupNonEssentialServerEntries
+ 
+ 	ServerDirectory inImageServers keys do: [:n |
+ 		n = 'etoys' ifFalse: [ServerDirectory removeServerNamed: n ifAbsent: []].
+ 	].
+ 	PrefsLocalProjectDirectories _ nil.
+ 	self resetLocalProjectDirectories.
+ !

Item was added:
+ ----- Method: ServerDirectory class>>inImageServerNames (in category '*Etoys-Squeakland-available servers') -----
+ inImageServerNames
+ 	^self inImageServers keys asSortedArray!

Item was added:
+ ----- Method: ServerDirectory class>>inImageServers (in category '*Etoys-Squeakland-available servers') -----
+ inImageServers
+ 	Servers ifNil: [Servers _ Dictionary new].
+ 	^Servers!

Item was added:
+ ----- Method: ServerDirectory class>>prefsLocalProjectDirectories (in category '*Etoys-Squeakland-available servers') -----
+ prefsLocalProjectDirectories
+ 	PrefsLocalProjectDirectories ifNil: [PrefsLocalProjectDirectories _ OrderedCollection new].
+ 	^PrefsLocalProjectDirectories!

Item was added:
+ ----- Method: ServerDirectory class>>prefsServers (in category '*Etoys-Squeakland-available servers') -----
+ prefsServers
+ 	PrefsServers ifNil: [PrefsServers _ Dictionary new].
+ 	^PrefsServers!

Item was added:
+ ----- Method: ServerDirectory class>>removePrefsServerNamed:ifAbsent: (in category '*Etoys-Squeakland-available servers') -----
+ removePrefsServerNamed: nameString ifAbsent: aBlock
+ 	self prefsServers removeKey: nameString ifAbsent: [aBlock value]!

Item was added:
+ ----- Method: ServerDirectory>>dirPathFor: (in category '*Etoys-Squeakland-accessing') -----
+ dirPathFor: fullName 
+ 	"Return the directory part the given name."
+ 	self
+ 		splitName: fullName
+ 		to: [:dirPath :localName | ^ dirPath]!

Item was added:
+ ----- Method: ServerDirectory>>userPerSe (in category '*Etoys-Squeakland-accessing') -----
+ userPerSe
+ 	"Answer the user, even if nil.  No interaction ensues."
+ 
+ 	^ user!

Item was added:
+ ----- Method: Set>>init: (in category '*Etoys-Squeakland-private') -----
+ init: n
+ 	"Initialize array to an array size of n"
+ 	array _ Array new: n.
+ 	tally _ 0!

Item was added:
+ ----- Method: Set>>keyAt: (in category '*Etoys-Squeakland-private') -----
+ keyAt: index
+ 	"May be overridden by subclasses so that fixCollisions will work"
+ 	^ array at: index!

Item was added:
+ ----- Method: Set>>noCheckAdd: (in category '*Etoys-Squeakland-private') -----
+ noCheckAdd: anObject
+ 	array at: (self findElementOrNil: anObject) put: anObject.
+ 	tally _ tally + 1!

Item was added:
+ ----- Method: Set>>swap:with: (in category '*Etoys-Squeakland-private') -----
+ swap: oneIndex with: otherIndex
+ 	"May be overridden by subclasses so that fixCollisions will work"
+ 
+ 	array swap: oneIndex with: otherIndex
+ !

Item was added:
+ ----- Method: Set>>withArray: (in category '*Etoys-Squeakland-private') -----
+ withArray: anArray
+ 	"private -- for use only in copy"
+ 	array _ anArray!

Item was added:
+ ----- Method: SharedQueue>>init: (in category '*Etoys-Squeakland-private') -----
+ init: size
+ 
+ 	contentsArray _ Array new: size.
+ 	readPosition _ 1.
+ 	writePosition _ 1.
+ 	accessProtect _ Semaphore forMutualExclusion.
+ 	readSynch _ Semaphore new!

Item was added:
+ ----- Method: SimpleButtonMorph>>labelString:font: (in category '*Etoys-Squeakland-accessing') -----
+ labelString: aString font: aFont
+ 
+ 	| existingLabel |
+ 	(existingLabel _ self findA: StringMorph)
+ 		ifNil:
+ 			[self label: aString font: aFont]
+ 		ifNotNil:
+ 			[existingLabel font: aFont; contents: aString.
+ 			self fitContents]
+ !

Item was added:
+ ----- Method: SimpleButtonMorph>>setAppearanceForEnablement: (in category '*Etoys-Squeakland-e-toy support') -----
+ setAppearanceForEnablement: aBoolean
+ 	"Set the receiver's  appearance to reflect the given enablement status, making the text color of my label black if the boolean is true, grey if it's false."
+ 
+ 	| aMorph |
+ 	(aMorph := self findA: StringMorph) ifNil: [^ self].
+ 	aMorph color: (aBoolean
+ 		ifTrue:
+ 			[Color black]
+ 		ifFalse:
+ 			[Color gray])!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph class>>on:list:selected:changeSelected:menu:keystroke:autoExpand: (in category '*Etoys-Squeakland-instance creation') -----
+ on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel autoExpand: aBoolean
+ 	"Create a 'pluggable' list view on the given model parameterized by the given message selectors. See ListView>>aboutPluggability comment."
+ 
+ 	^ self new
+ 		on: anObject
+ 		list: getListSel
+ 		selected: getSelectionSel
+ 		changeSelected: setSelectionSel
+ 		menu: getMenuSel
+ 		keystroke: keyActionSel
+ 		autoExpand: aBoolean
+ !

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>on:list:selected:changeSelected:menu:keystroke:autoExpand: (in category '*Etoys-Squeakland-initialization') -----
+ on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel autoExpand: aBoolean
+ 
+ 	self setProperty: #autoExpand toValue: aBoolean.
+ 	self model: anObject.
+ 	getListSelector _ getListSel.
+ 	getSelectionSelector _ getSelectionSel.
+ 	setSelectionSelector _ setSelectionSel.
+ 	getMenuSelector _ getMenuSel.
+ 	keystrokeActionSelector _ keyActionSel.
+ 	autoDeselect _ true.
+ 	self borderWidth: 1.
+ 	self list: self getList.
+ !

Item was added:
+ Morph subclass: #SimpleSelectionMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Support'!
+ 
+ !SimpleSelectionMorph commentStamp: 'sw 8/3/2009 22:00' prior: 0!
+ A morph used in the implementaiton of Karl Ramberg's omnidirectional grab-patch tool!

Item was added:
+ ----- Method: SimpleSelectionMorph>>extendByHand: (in category 'extending') -----
+ extendByHand: aHand
+ 	"Assumes selection has just been created and added to some pasteUp or world"
+ 
+ 	| startPoint handle m inner |
+ 	startPoint := Sensor cursorPoint.
+ 
+ 	handle := NewHandleMorph new followHand: aHand
+ 		forEachPointDo: [:newPoint |
+ 					| localPt |
+ 					Cursor crossHair show.
+ 					localPt := (self transformFrom: self world) globalPointToLocal: newPoint.
+ 					self bounds: (startPoint rect: localPt)]
+ 		lastPointDo:
+ 			 [:newPoint |
+ 			inner := self bounds insetBy: 2 at 2.
+ 			inner area >= 16
+ 				ifTrue:
+ 					[m := SketchMorph new form: (Form fromDisplay: inner).
+ 					aHand attachMorph: m.
+ 					ActiveWorld fullRepaintNeeded]  "selection tracking can leave unwanted artifacts"
+ 				ifFalse:
+ 					[Beeper beep].  "throw minnows back"
+ 			self delete].
+ 			
+ 	handle visible: false.
+ 	aHand attachMorph: handle.
+ 	handle startStepping!

Item was added:
+ ----- Method: SimpleSelectionMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 
+ 	super initialize.
+ 	self color: Color transparent.
+         self borderColor: Color black.
+ 	self borderWidth: 2.
+ 	self setProperty: #ignorePartsBinDrop toValue: true!

Item was added:
+ ----- Method: SimplifiedChineseEnvironment class>>scanSelector (in category '*Etoys-Squeakland-rendering support') -----
+ scanSelector
+ 
+ 	^ #scanSimChineseCharactersFrom:to:in:rightX:stopConditions:kern:
+ !

Item was added:
+ ----- Method: SketchEditorMorph>>addHelpNextButton (in category '*Etoys-Squeakland-start & finish') -----
+ addHelpNextButton
+ 	"This is a TOTAL hack.  When the Help Guide is showing, and the user starts painting, the next-page button in the Guide is obscured.  A beginner will not know what to do to see the next page of help.  He can see the next page button, but clicking paints a dot.  
+ 	To cure this, we make a copy of the NextPage button and put it on top of the paint area.  Clicking it turns the page in the guide.
+ 	If the user closes help while painting, we do not delete the button."
+ 
+ 	| np gg nextPageButton |
+ 	gg _ Project current helpGuideIfOpen ifNil: [^ nil].
+ 	np _ gg pageControls findDeepSubmorphThat: [:mm | 
+ 			(mm respondsTo: #actionSelector) 
+ 				ifTrue: [mm actionSelector == #nextPage]
+ 				ifFalse: [false] ] 
+ 		ifAbsent: [^ nil].
+ 	(np bounds intersects: self bounds) ifFalse: [^ nil].
+ 	nextPageButton _ np veryDeepCopy.
+ 	nextPageButton on: #mouseEnter send: #mouseLeave: to: self.
+ 		"Hide brush cursor"
+ 	nextPageButton on: #mouseLeave send: #mouseEnter: to: self.
+ 		"Show brush cursor"
+ 	"nextPageButton hasRolloverBorder: true.		Just too much"
+ 	self addMorph: nextPageButton.!

Item was added:
+ ----- Method: SketchEditorMorph>>findBounds:in:forBackground: (in category '*Etoys-Squeakland-start & finish') -----
+ findBounds: sketch in: aPasteUpMorph forBackground: forBackground
+ 	"Return the final painting area (onion skin) where the user will paint.  Compute the new location of the referencePoint (used to comput rotationCenter) as an offset in the paint area.  Ugly but necessary."
+ 
+ 	| margin refPtOffset bnds screen delta delta2 |
+ 	"Always keep old sketch in center of paint area -- that is what onion skin blt will do"
+ 	refPtOffset := "0 at 0 +" (sketch form extent * sketch rotationCenter).
+ 	screen := aPasteUpMorph world bounds.
+ 	bnds := 0 at 0 corner: sketch form extent.
+ 	bnds := bnds align: refPtOffset with:  sketch referencePositionInWorld.
+ 	"offset is relative inside bnds"
+ 	bnds extent > screen extent 
+ 		ifTrue: ["expanded sketch is bigger than world"
+ 			refPtOffset := refPtOffset - (bnds extent - screen extent //2).	"must keep at the right place in rectangle"
+ 			bnds := screen]
+ 		ifFalse: ["move so not off screen" 
+ 			delta := bnds amountToTranslateWithin: screen.
+ 			bnds := bnds translateBy: delta]. 	"refPtOffset stays the same -- relative"
+ 
+ 	"give it extra margin if any space left"
+ 	delta2 := bnds extent - screen extent //2.
+ 	(forBackground not and: [delta2 < (0 at 0)]) ifTrue: [
+ 		margin := (60 at 60) max: ((aPasteUpMorph reasonablePaintingExtent - bnds extent) // 2).
+ 		margin := margin min: delta2 negated.
+ 		bnds := bnds expandBy: margin. 
+ 		refPtOffset := refPtOffset + margin.	
+ 		delta := bnds amountToTranslateWithin: screen.
+ 		bnds := bnds translateBy: delta]. 	"refPtOffset stays the same -- relative"
+ 
+ 	forBackground ifTrue: [bnds := screen]
+ 		ifFalse: [self setProperty: #refPtOffset toValue:  refPtOffset].
+ 	^ bnds!

Item was changed:
  ----- Method: SketchMorph class>>additionsToViewerCategories (in category '*eToys-scripting') -----
  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."
  
  	^ #((graphics (
  (slot graphic 	'The picture currently being worn' Graphic	 readWrite Player getGraphic Player setGraphic:)
  (command wearCostumeOf: 'wear the costume of...' Player)
  (slot baseGraphic 	'The picture originally painted for this object, but can subsequently be changed via menu or script' Graphic	 readWrite Player getBaseGraphic Player setBaseGraphic:)
  (command restoreBaseGraphic 'Make my picture be the one I remember in my baseGraphic')
  
  (slot rotationStyle 'How the picture should change when the heading is modified' RotationStyle readWrite Player getRotationStyle Player setRotationStyle:)
+ (command flipLeftRight 'Flip the picture left to right' Player)
+ (command flipUpDown 'Flip the picture upside down' Player)
  )))
  
  
  !

Item was added:
+ ----- Method: SketchMorph class>>additionsToViewerCategoryGraphicsFilters (in category '*Etoys-Squeakland-eToys-scripting') -----
+ additionsToViewerCategoryGraphicsFilters
+ 	"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."
+ 
+ 	^ #(
+ #'graphics filters' 
+ (
+ (slot hueShift 'Shift the hue of the pictures colors. -360 to 360' Number readWrite Player getHueShift Player setHueShift:)
+ (slot brightnessShift 'Shift the brightness of the picture. -100 to 100' Number readWrite Player getBrightnessShift Player setBrightnessShift:)
+ (slot saturationShift 'Shift the saturation of the pictures colors. -100 to 100' Number readWrite Player getSaturationShift Player setSaturationShift:)
+ (slot blur 'Blur the picture. 1 to 10' Number readWrite Player getBlur Player setBlur:)
+ (slot fishEye 'Make a fish eye effect on the picture. -10 and up' Number readWrite Player getFishEye Player setFishEye:)
+ (slot whirl 'Make a whirl effect on the picture.' Number readWrite Player getWhirl Player setWhirl:)
+ (command removeFilters 'Remove the picture filters' )
+ ))
+ 
+ 
+ !

Item was added:
+ ----- Method: SketchMorph>>blur:form: (in category '*Etoys-Squeakland-filters') -----
+ blur: aWidth form: filteredForm 
+ 	| f fOut fWidth |
+ 	aWidth = 0 ifTrue:[^ filteredForm].
+ 	f := filteredForm asFormOfDepth: 32.
+ 	fWidth := f width + (aWidth - 1) max: f width.
+ 	fOut := f deepCopy.
+ 	ScratchPlugin
+ 		primBlur: f bits
+ 		into: fOut bits
+ 		width: fWidth.
+ 	^ fOut asFormOfDepth: 16!

Item was added:
+ ----- Method: SketchMorph>>brightnessShift:form: (in category '*Etoys-Squeakland-filters') -----
+ brightnessShift: aShift form: filteredForm 
+ 	| f fOut shift |
+ 	aShift = 0 ifTrue:[^ filteredForm].
+ 	shift := aShift min: 100 max: -100.
+ 	f := filteredForm asFormOfDepth: 32.
+ 	fOut := f deepCopy.
+ 	ScratchPlugin
+ 		primShiftBrightness: f bits
+ 		into: fOut bits
+ 		by: shift.
+ 	^ fOut asFormOfDepth: 16!

Item was added:
+ ----- Method: SketchMorph>>doesColorAndBorder (in category '*Etoys-Squeakland-other') -----
+ doesColorAndBorder
+ 	"Answer whether color and border protocols make sense for the receiver."
+ 
+ 	^ false!

Item was added:
+ ----- Method: SketchMorph>>filters (in category '*Etoys-Squeakland-filters') -----
+ filters
+ 	^ self valueOfProperty: #filters ifAbsentPut:
+ 		[OrderedCollection new]!

Item was added:
+ ----- Method: SketchMorph>>filtersAdd: (in category '*Etoys-Squeakland-filters') -----
+ filtersAdd: aFilterWithValue 
+ 	self filters
+ 		do: [:i | (i includes: aFilterWithValue first)
+ 				ifTrue: [self filters remove: i]].
+ 	self filters add: aFilterWithValue.
+ 	self layoutChanged!

Item was added:
+ ----- Method: SketchMorph>>fishEye:form: (in category '*Etoys-Squeakland-filters') -----
+ fishEye: aPower form: aForm
+ | f fOut power |
+ 	aPower = 0 ifTrue:[^aForm].
+ 	power := (100 + (aPower * 10)) max:0.
+ 	f := aForm asFormOfDepth: 32.
+ 	fOut := f deepCopy.
+ 	ScratchPlugin primFisheye: f bits into: fOut bits width: f width power: power.
+ 	^fOut  asFormOfDepth: 16!

Item was added:
+ ----- Method: SketchMorph>>form:rotationCenter: (in category '*Etoys-Squeakland-accessing') -----
+ form: aForm rotationCenter: aCenter
+ 	"Set the receiver's form, honoring a rotation center.  Maintains existing cartesian location of the receiver across the changed form and rotation center."
+ 
+ 	| loc |
+ 	loc := self topRendererOrSelf assuredPlayer getLocation.
+ 	(self hasProperty: #baseGraphic) ifFalse: [self setProperty: #baseGraphic toValue: aForm].
+ 	originalForm _ aForm.
+ 	self rotationCenter: aCenter.
+ 	self layoutChanged.
+ 	self topRendererOrSelf player setLocation: loc!

Item was added:
+ ----- Method: SketchMorph>>hueShift:form: (in category '*Etoys-Squeakland-filters') -----
+ hueShift: aShift form: filteredForm 
+ 	| f fOut shift |
+ 	aShift = 0 ifTrue:[^ filteredForm].
+ 	shift := aShift min: 360 max: -360.
+ 	f := filteredForm asFormOfDepth: 32.
+ 	fOut := f deepCopy.
+ 	ScratchPlugin
+ 		primShiftHue: f bits
+ 		into: fOut bits
+ 		byDegrees: shift.
+ 	^ fOut asFormOfDepth: 16!

Item was added:
+ ----- Method: SketchMorph>>recolorPixelsOfColor: (in category '*Etoys-Squeakland-menu') -----
+ 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 at 0
+ 		colorMap: map.
+ 	self form: newForm.
+ !

Item was added:
+ ----- Method: SketchMorph>>removeFilters (in category '*Etoys-Squeakland-filters') -----
+ removeFilters
+ 	self removeProperty: #filters.
+ 	self layoutChanged!

Item was added:
+ ----- Method: SketchMorph>>restoreOriginalAspectRatio (in category '*Etoys-Squeakland-menu') -----
+ restoreOriginalAspectRatio
+ 	"Adjust my width, keeping my height the same, such that my original aspect ratio is restored."
+ 
+ 	| aRatio |
+ 	aRatio := originalForm width asFloat / originalForm height.
+ 	self extent: ((aRatio * self height ) @ self height).!

Item was added:
+ ----- Method: SketchMorph>>saturationShift:form: (in category '*Etoys-Squeakland-filters') -----
+ saturationShift: aShift form: filteredForm 
+ 	| f fOut shift |
+ 	aShift = 0 ifTrue:[^ filteredForm].
+ 	shift := aShift min: 100 max: -100.
+ 	f := filteredForm asFormOfDepth: 32.
+ 	fOut := f deepCopy.
+ 	ScratchPlugin
+ 		primShiftSaturation: f bits
+ 		into: fOut bits
+ 		by: shift.
+ 	^ fOut asFormOfDepth: 16!

Item was added:
+ ----- Method: SketchMorph>>whirl:form: (in category '*Etoys-Squeakland-filters') -----
+ whirl: anAngle form: aForm
+ 	| f fOut |
+ 	anAngle = 0 ifTrue:[^aForm].
+ 	
+ 	f := aForm asFormOfDepth: 32.
+ 	fOut := f deepCopy.
+ 	ScratchPlugin primWhirl: f bits into: fOut bits width: f width angle: anAngle.
+ 	^fOut  asFormOfDepth: 16!

Item was added:
+ Collection subclass: #SkipList
+ 	instanceVariableNames: 'sortBlock pointers numElements level splice'
+ 	classVariableNames: 'Rand'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Collections-SkipLists'!
+ 
+ !SkipList commentStamp: 'KLC 2/26/2004 12:04' prior: 0!
+ From "Skip Lists: A Probabilistic Alternative to Balanced Trees" by William Pugh ( http://epaperpress.com/sortsearch/download/skiplist.pdf ):
+ 
+ "Skip lists are a data structure that can be used in place of balanced trees.  Skip lists use probabilistic balancing rather than strictly enforcing balancing and as a result the algorithms for insertion and deletion in skip lists are much simpler and significantly faster than equivalent algorithms for balanced trees."
+ 
+ Notes:
+ 
+ The elements of the skip list must implement #< or you must provide a sort block.
+ 
+ !

Item was added:
+ ----- Method: SkipList class>>maxLevel: (in category 'instance creation') -----
+ maxLevel: maxLevel
+ 	"
+ 	SkipList maxLevel: 5
+ 	"
+ 	^ super new initialize: maxLevel!

Item was added:
+ ----- Method: SkipList class>>maxLevel:sortBlock: (in category 'instance creation') -----
+ maxLevel: anInteger sortBlock: aBlock
+ 	^ (self maxLevel: anInteger) sortBlock: aBlock!

Item was added:
+ ----- Method: SkipList class>>new (in category 'instance creation') -----
+ new
+ 	"
+ 	SkipList new
+ 	"
+ 	^ super new initialize: 10!

Item was added:
+ ----- Method: SkipList class>>new: (in category 'instance creation') -----
+ new: anInteger
+ 	^ self maxLevel: (anInteger log: 2) ceiling!

Item was added:
+ ----- Method: SkipList class>>new:sortBlock: (in category 'instance creation') -----
+ new: anInteger sortBlock: aBlock
+ 	^ (self new: anInteger) sortBlock: aBlock!

Item was added:
+ ----- Method: SkipList class>>newFrom: (in category 'instance creation') -----
+ newFrom: aCollection 
+ 	| skipList |
+ 	skipList _ self new: aCollection size.
+ 	skipList addAll: aCollection.
+ 	^ skipList!

Item was added:
+ ----- Method: SkipList class>>sortBlock: (in category 'instance creation') -----
+ sortBlock: aBlock
+ 	^ self new sortBlock: aBlock!

Item was added:
+ ----- Method: SkipList>>add: (in category 'adding') -----
+ add: element 
+ 	self add: element ifPresent: nil.
+ 	^ element!

Item was added:
+ ----- Method: SkipList>>add:ifPresent: (in category 'adding') -----
+ add: element ifPresent: aBlock
+ 	| node lvl s |
+ 	node _ self search: element updating: splice.
+ 	node ifNotNil: [aBlock ifNotNil: [^ aBlock value: node]].
+ 	lvl _ self randomLevel.
+ 	node _ SkipListNode on: element level: lvl.
+ 	level + 1 to: lvl do: [:i | splice at: i put: self].
+ 	1 to: lvl do: [:i |
+ 				s _ splice at: i.
+ 				node atForward: i put: (s forward: i).
+ 				s atForward: i put: node].
+ 	numElements _ numElements + 1.
+ 	splice atAllPut: nil.
+ 	^ element
+ !

Item was added:
+ ----- Method: SkipList>>atForward:put: (in category 'private') -----
+ atForward: i put: node
+ 	level _ node
+ 		ifNil: [pointers findLast: [:n | n notNil]]
+ 		ifNotNil: [level max: i].
+ 	^ pointers at: i put: node!

Item was added:
+ ----- Method: SkipList>>do: (in category 'enumerating') -----
+ do: aBlock
+ 	self nodesDo: [:node | aBlock value: node object]!

Item was added:
+ ----- Method: SkipList>>forward: (in category 'private') -----
+ forward: i 
+ 	^ pointers at: i!

Item was added:
+ ----- Method: SkipList>>includes: (in category 'testing') -----
+ includes: element
+ 	^ (self search: element updating: nil) notNil!

Item was added:
+ ----- Method: SkipList>>initialize: (in category 'initialization') -----
+ initialize: maxLevel
+ 	pointers _ Array new: maxLevel.
+ 	splice _ Array new: maxLevel.
+ 	numElements _ 0.
+ 	level _ 0.
+ 	Rand ifNil: [Rand _ Random new]!

Item was added:
+ ----- Method: SkipList>>is:before: (in category 'private') -----
+ is: node before: element 
+ 	| object |
+ 	node ifNil: [^ false].
+ 	object _ node object.
+ 	^ sortBlock
+ 		ifNil: [object < element]
+ 		ifNotNil: [(self is: object equalTo: element) ifTrue: [^ false].
+ 			sortBlock value: object value: element]!

Item was added:
+ ----- Method: SkipList>>is:equalTo: (in category 'element comparison') -----
+ is: element1 equalTo: element2
+ 	^ element1 = element2!

Item was added:
+ ----- Method: SkipList>>is:theNodeFor: (in category 'private') -----
+ is: node theNodeFor: element 
+ 	node ifNil: [^ false].
+ 	node == self ifTrue: [^ false].
+ 	^ self is: node object equalTo: element!

Item was added:
+ ----- Method: SkipList>>isEmpty (in category 'testing') -----
+ isEmpty
+ 	^ numElements = 0!

Item was added:
+ ----- Method: SkipList>>level (in category 'accessing') -----
+ level
+ 	^ level!

Item was added:
+ ----- Method: SkipList>>maxLevel (in category 'accessing') -----
+ maxLevel
+ 	^ pointers size!

Item was added:
+ ----- Method: SkipList>>maxLevel: (in category 'accessing') -----
+ maxLevel: n
+ 	| newLevel oldPointers |
+ 	newLevel _ n max: level.
+ 	oldPointers _ pointers.
+ 	pointers _ Array new: newLevel.
+ 	splice _ Array new: newLevel.
+ 	1 to: level do: [:i | pointers at: i put: (oldPointers at: i)]
+ !

Item was added:
+ ----- Method: SkipList>>next (in category 'private') -----
+ next
+ 	^ pointers first!

Item was added:
+ ----- Method: SkipList>>nodesDo: (in category 'node enumeration') -----
+ nodesDo: aBlock
+ 	| node |
+ 	node _ pointers first.
+ 	[node notNil]
+ 		whileTrue:
+ 			[aBlock value: node.
+ 			node _ node next]!

Item was added:
+ ----- Method: SkipList>>randomLevel (in category 'private') -----
+ randomLevel
+ 	| p answer max |
+ 	p _ 0.5.
+ 	answer _ 1.
+ 	max _ self maxLevel.
+ 	[Rand next < p and: [answer < max]]
+ 		whileTrue: [answer _ answer + 1].
+ 	^ answer!

Item was added:
+ ----- Method: SkipList>>remove: (in category 'removing') -----
+ remove: element 
+ 	^ self remove: element ifAbsent: [self errorNotFound: element]!

Item was added:
+ ----- Method: SkipList>>remove:ifAbsent: (in category 'removing') -----
+ remove: element ifAbsent: aBlock
+ 	| node i s |
+ 	node _ self search: element updating: splice.
+ 	node ifNil: [^ aBlock value].
+ 	i _ 1.
+ 	[s _ splice at: i.
+ 	i <= level and: [(s forward: i) == node]]
+ 				whileTrue:
+ 					[s atForward: i put: (node forward: i).
+ 					i _ i + 1].
+ 	numElements _ numElements - 1.
+ 	splice atAllPut: nil.
+ 	^ node object
+ !

Item was added:
+ ----- Method: SkipList>>removeAll (in category 'removing') -----
+ removeAll
+ 	pointers atAllPut: nil.
+ 	splice atAllPut: nil.
+ 	numElements _ 0.
+ 	level _ 0.!

Item was added:
+ ----- Method: SkipList>>search:updating: (in category 'private') -----
+ search: element updating: array
+ 	| node forward |
+ 	node _ self.
+ 	level to: 1 by: -1 do: [:i |
+ 			[forward _ node forward: i.
+ 			self is: forward before: element] whileTrue: [node _ forward].
+ 			"At this point: node < element <= forward"
+ 			array ifNotNil: [array at: i put: node]].
+ 	node _ node next.
+ 	^ (self is: node theNodeFor: element) ifTrue: [node]!

Item was added:
+ ----- Method: SkipList>>size (in category 'accessing') -----
+ size
+ 	^ numElements!

Item was added:
+ ----- Method: SkipList>>sortBlock (in category 'accessing') -----
+ sortBlock
+ 	^ sortBlock!

Item was added:
+ ----- Method: SkipList>>sortBlock: (in category 'accessing') -----
+ sortBlock: aBlock
+ 	sortBlock _ aBlock!

Item was added:
+ Object subclass: #SkipListNode
+ 	instanceVariableNames: 'pointers object'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Collections-SkipLists'!

Item was added:
+ ----- Method: SkipListNode class>>new: (in category 'instance creation') -----
+ new: maxLevel
+ 	^ super new initialize: maxLevel!

Item was added:
+ ----- Method: SkipListNode class>>on:level: (in category 'instance creation') -----
+ on: element level: maxLevel 
+ 	^ (self new: maxLevel)
+ 		object: element!

Item was added:
+ ----- Method: SkipListNode class>>tailOfLevel: (in category 'instance creation') -----
+ tailOfLevel: n
+ 	^ self on: nil level: n!

Item was added:
+ ----- Method: SkipListNode>>atForward:put: (in category 'accessing') -----
+ atForward: i put: node
+ 	^ pointers at: i put: node!

Item was added:
+ ----- Method: SkipListNode>>forward: (in category 'accessing') -----
+ forward: i 
+ 	^ pointers at: i!

Item was added:
+ ----- Method: SkipListNode>>initialize: (in category 'initialization') -----
+ initialize: maxLevel
+ 	pointers _ Array new: maxLevel!

Item was added:
+ ----- Method: SkipListNode>>level (in category 'accessing') -----
+ level
+ 	^ pointers size!

Item was added:
+ ----- Method: SkipListNode>>next (in category 'accessing') -----
+ next
+ 	^ pointers first!

Item was added:
+ ----- Method: SkipListNode>>object (in category 'accessing') -----
+ object
+ 	^ object!

Item was added:
+ ----- Method: SkipListNode>>object: (in category 'private') -----
+ object: anObject
+ 	object _ anObject!

Item was added:
+ ----- Method: SkipListNode>>printOn: (in category 'printing') -----
+ printOn: aStream
+ 	| first |
+ 	aStream
+ 		nextPut: $[;
+ 		nextPutAll: object printString;
+ 		nextPutAll: ']-->('.
+ 	first _ true.
+ 	pointers do: [:node |
+ 		first ifTrue: [first _ false] ifFalse: [aStream space].
+ 		aStream nextPutAll: (node ifNil: ['*'] ifNotNil: [node object printString])].
+ 	aStream nextPut: $)
+ !

Item was added:
+ ----- Method: Slider>>sliderBalloonHelp: (in category '*Etoys-Squeakland-access') -----
+ sliderBalloonHelp: aString
+ 	"Set the balloon help of the moving part of the receiver to the string provided."
+ 
+ 	slider ifNotNil: [slider setBalloonText: aString]!

Item was added:
+ Environment subclass: #SmalltalkEnvironment
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Environments'!

Item was added:
+ ----- Method: SmalltalkImage>>lastUpdateStringTranslated (in category '*Etoys-Squeakland-sources, changes log') -----
+ lastUpdateStringTranslated
+ 	"SmalltalkImage current lastUpdateStringTranslated"
+ 	| update |
+ 	update := 'latest update: #' translated, SystemVersion current highestUpdate printString.
+ 	 SystemVersion current repositoryVersion > 0 ifTrue: [
+ 		update := update, ' (', SystemVersion current repositoryString, ')']. 
+ 	^update!

Item was added:
+ ----- Method: SmalltalkImage>>macVmMajorMinorBuildVersion (in category '*Etoys-Squeakland-system attribute') -----
+ macVmMajorMinorBuildVersion	
+ 	"SmalltalkImage current macVmMajorMinorBuildVersion"
+ 	| aString rawTokens versionPart versionTokens versionArray |
+ 	aString := self vmVersion.
+ 	aString ifNil: [^ #(0 0 0)].
+ 	rawTokens := ((aString copyAfter: $])
+ 				findTokens: $ ).
+ 	versionPart := rawTokens detect: [:each | each includes: $.] ifNone: [^#(0 0 0)]. 
+ 	versionTokens := versionPart findTokens: $..
+ 	versionArray := #(0 0 0) collectWithIndex: [:each :index |
+ 		(versionTokens at: index ifAbsent:['']) initialIntegerOrNil ifNil: [each]].
+ 	^versionArray!

Item was added:
+ ----- Method: SmalltalkImage>>macVmMajorMinorBuildVersionString (in category '*Etoys-Squeakland-system attribute') -----
+ macVmMajorMinorBuildVersionString
+ 	"SmalltalkImage current macVmMajorMinorBuildVersionString"
+ 	^ String
+ 		streamContents: [:str | self macVmMajorMinorBuildVersion
+ 				do: [:each | str nextPutAll: each asString]
+ 				separatedBy: [str nextPut: $.]]!

Item was added:
+ ----- Method: SmalltalkImage>>systemInformationStringTranslated (in category '*Etoys-Squeakland-sources, changes log') -----
+ systemInformationStringTranslated
+ 	"Identify software version"
+ 	^ SystemVersion current version, String cr, self lastUpdateStringTranslated!

Item was added:
+ ----- Method: SmartRefStream>>alansTextPlusMorphbosfcebbmsopssrsggshtt0 (in category '*Etoys-Squeakland-conversion') -----
+ alansTextPlusMorphbosfcebbmsopssrsggshtt0
+ 
+ 	^ TextPlusMorph!

Item was added:
+ ----- Method: SmartRefStream>>sMInstallationRegistryiim0 (in category '*Etoys-Squeakland-conversion') -----
+ sMInstallationRegistryiim0
+ 
+ 	^ SMInstallationRegistry!

Item was added:
+ ----- Method: SmartRefStream>>sMMaintainableObjectimcunsucromrf0 (in category '*Etoys-Squeakland-conversion') -----
+ sMMaintainableObjectimcunsucromrf0
+ 
+ 	^ SMMaintainableObject!

Item was added:
+ ----- Method: SocketStream>>contents (in category '*Etoys-Squeakland-accessing') -----
+ contents
+ 	"Answer with a copy of my collection from 1 to readLimit."
+ 
+ 	^collection ifNotNil: [collection copyFrom: 1 to: readLimit]!

Item was added:
+ ----- Method: SocketStream>>streamBuffer (in category '*Etoys-Squeakland-private') -----
+ streamBuffer
+ 	^(self isBinary
+ 		ifTrue: [ByteArray]
+ 		ifFalse: [ByteString]) new: self bufferSize!

Item was added:
+ FlapTab subclass: #SolidSugarSuppliesTab
+ 	instanceVariableNames: 'sugarNavTab'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sugar'!
+ 
+ !SolidSugarSuppliesTab commentStamp: 'sw 9/2/2007 03:37' prior: 0!
+ Represents the horizontal "solid" tab by which the sugar-supplies flap can be resized.  When the supplies flap is *closed*, the tab is invisible.!

Item was added:
+ ----- Method: SolidSugarSuppliesTab>>addCustomMenuItems:hand: (in category 'show & hide') -----
+ addCustomMenuItems: aMenu hand: aHand
+ 	"Overridden in order to thwart super."
+ 
+ !

Item was added:
+ ----- Method: SolidSugarSuppliesTab>>adjustPositionAfterHidingFlap (in category 'show & hide') -----
+ adjustPositionAfterHidingFlap
+ 	"Make the receiver, in effect, invisible when the flap is closed."
+ 
+ 	super adjustPositionAfterHidingFlap.
+ 	self setProperty: #heightWhenOpen toValue: self height.
+ 	self height: 0	!

Item was added:
+ ----- Method: SolidSugarSuppliesTab>>arrangeToPopOutOnDragOver: (in category 'initialization') -----
+ arrangeToPopOutOnDragOver: aBoolean
+ 	"Set up the receiver to respond appropriately to mouse-enter-dragging and mouse-leave-dragging situations."
+ 
+ 	aBoolean
+ 		ifTrue:
+ 			[referent on: #mouseLeaveDragging send: #maybeHideFlapOnMouseLeaveDragging to: self.
+ 			self on: #mouseLeaveDragging send: #maybeHideFlapOnMouseLeaveDragging to: self]
+ 		ifFalse:
+ 			[self on: #mouseEnterDragging send: nil to: nil.
+ 			referent on: #mouseLeaveDragging send: nil to: nil.
+ 			self on: #mouseLeaveDragging send: nil to: nil]!

Item was added:
+ ----- Method: SolidSugarSuppliesTab>>initialize (in category 'initialization') -----
+ initialize
+ 	"Set up the receiver to have a solid tab."
+ 
+ 	super initialize.
+ 	self useSolidTab.
+ 	"self applyThickness: 20."!

Item was added:
+ ----- Method: SolidSugarSuppliesTab>>mouseMove: (in category 'event handling') -----
+ mouseMove: evt
+ 	"Handle a mouse-move within the solid tab."
+ 
+ 	| aPosition newReferentThickness adjustedPosition thick |
+ 	dragged ifFalse: [(thick _ self referentThickness) > 0
+ 		ifTrue: [lastReferentThickness _ thick]].
+ 
+ 	aPosition _ evt cursorPoint.
+ 	edgeToAdhereTo == #top
+ 		ifTrue:
+ 			[adjustedPosition _ aPosition - evt hand targetOffset.
+ 			newReferentThickness _ adjustedPosition y - sugarNavTab height]
+ 		ifFalse:
+ 			[adjustedPosition := aPosition + evt hand targetOffset.
+ 			newReferentThickness := self world height - (adjustedPosition y + sugarNavTab height)].
+ 
+ 	self applyThickness: newReferentThickness.
+ 	dragged _ true.
+ 	self fitOnScreen.
+ 	self computeEdgeFraction!

Item was added:
+ ----- Method: SolidSugarSuppliesTab>>positionObject:atEdgeOf: (in category 'mechanics') -----
+ positionObject: anObject atEdgeOf: container
+ 	"Position an object -- either the receiver or its referent -- on the edge of the container."
+ 
+ 	| extra |
+ 	extra _ (sugarNavTab notNil and: [referent isInWorld])
+ 		ifTrue:
+ 			[sugarNavTab height]
+ 		ifFalse:
+ 			[0].
+ 
+ 	edgeToAdhereTo == #top ifTrue:
+ 		[^ anObject top: container top + extra].
+ 
+ 	"bottom..."
+ 	anObject == self
+ 		ifFalse:   "the parts bin"
+ 			[anObject bottom: (container bottom - extra)]
+ 		ifTrue:  "the tab"
+ 			[anObject bottom: (container bottom - (self referentThickness + extra))] !

Item was added:
+ ----- Method: SolidSugarSuppliesTab>>showFlap (in category 'show & hide') -----
+ showFlap
+ 	"Open the flap up"
+ 
+ 	self height: (self valueOfProperty: #heightWHenOpen ifAbsent: [20]).
+ 	super showFlap!

Item was added:
+ ----- Method: SolidSugarSuppliesTab>>spanWorld (in category 'positioning') -----
+ spanWorld
+ 	"Make the receiver's width commensurate with that of the container."
+ 
+ 	super spanWorld.
+ 	self width:  self pasteUpMorph width!

Item was added:
+ ----- Method: SolidSugarSuppliesTab>>sugarNavTab: (in category 'initialization') -----
+ sugarNavTab: anObject
+ 	"Set the receiver's sugarNavTab."
+ 
+ 	sugarNavTab _ anObject!

Item was added:
+ ----- Method: SolidSugarSuppliesTab>>wantsToBeTopmost (in category 'mechanics') -----
+ wantsToBeTopmost
+ 	"Answer true iff flap is currently showing."
+ 
+ 	^ self flapShowing
+ !

Item was added:
+ ----- Method: SoundCodec class>>isAvailable (in category '*Etoys-Squeakland-accessing') -----
+ isAvailable
+ 	^ true!

Item was added:
+ ----- Method: SoundCodec>>decodeCompressedDataNoReset: (in category '*Etoys-Squeakland-compress/decompress') -----
+ decodeCompressedDataNoReset: aByteArray
+ 	"Decode the entirety of the given encoded data buffer with this codec. Answer a monophonic SoundBuffer containing the uncompressed samples."
+ 
+ 	| frameCount result increments |
+ 	frameCount := self frameCount: aByteArray.
+ 	result := SoundBuffer newMonoSampleCount: frameCount * self samplesPerFrame.
+ 	"self reset."
+ 	increments := self decodeFrames: frameCount from: aByteArray at: 1 into: result at: 1.
+ 	((increments first = aByteArray size) and: [increments last = result size]) ifFalse: [
+ 		self error: 'implementation problem; increment sizes should match buffer sizes'].
+ 	^ result
+ !

Item was added:
+ ----- Method: SoundCodec>>encodeSoundBufferNoReset: (in category '*Etoys-Squeakland-compress/decompress') -----
+ encodeSoundBufferNoReset: aSoundBuffer
+ 	"Encode the entirety of the given monophonic SoundBuffer with this codec. Answer a ByteArray containing the compressed sound data."
+ 
+ 	| codeFrameSize frameSize fullFrameCount lastFrameSamples result increments finalFrame i lastIncs |
+ 	frameSize _ self samplesPerFrame.
+ 	fullFrameCount _ aSoundBuffer monoSampleCount // frameSize.
+ 	lastFrameSamples _ aSoundBuffer monoSampleCount - (fullFrameCount * frameSize).
+ 	codeFrameSize _ self bytesPerEncodedFrame.
+ 	codeFrameSize = 0 ifTrue:
+ 		["Allow room for 1 byte per sample for variable-length compression"
+ 		codeFrameSize _ frameSize].
+ 	lastFrameSamples > 0
+ 		ifTrue: [result _ ByteArray new: (fullFrameCount + 1) * codeFrameSize]
+ 		ifFalse: [result _ ByteArray new: fullFrameCount * codeFrameSize].
+ 	"self reset."
+ 	increments _ self encodeFrames: fullFrameCount from: aSoundBuffer at: 1 into: result at: 1.
+ 	lastFrameSamples > 0 ifTrue: [
+ 		finalFrame _ SoundBuffer newMonoSampleCount: frameSize.
+ 		i _ fullFrameCount * frameSize.
+ 		1 to: lastFrameSamples do: [:j |
+ 			finalFrame at: j put: (aSoundBuffer at: (i _ i + 1))].
+ 		lastIncs _ self encodeFrames: 1 from: finalFrame at: 1 into: result at: 1 + increments second.
+ 		increments _ Array with: increments first + lastIncs first
+ 							with: increments second + lastIncs second].
+ 	increments second < result size
+ 		ifTrue: [^ result copyFrom: 1 to: increments second]
+ 		ifFalse: [^ result]
+ !

Item was added:
+ AlignmentMorph subclass: #SoundDemoMorph
+ 	instanceVariableNames: 'soundColumn'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sound-Interface'!

Item was added:
+ ----- Method: SoundDemoMorph>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ 	"answer the default border width for the receiver"
+ 	^ 2!

Item was added:
+ ----- Method: SoundDemoMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color lightGray!

Item was added:
+ ----- Method: SoundDemoMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	self listDirection: #topToBottom;
+ 		 wrapCentering: #center;
+ 		 cellPositioning: #topCenter;
+ 		 hResizing: #spaceFill;
+ 		 vResizing: #spaceFill;
+ 		 layoutInset: 3;
+ 		 addMorph: self makeControls;
+ 	initializeSoundColumn.
+ 	self extent: 118 @ 150!

Item was added:
+ ----- Method: SoundDemoMorph>>initializeSoundColumn (in category 'initialization') -----
+ initializeSoundColumn
+ "initialize the receiver's soundColumn"
+ 	soundColumn _ AlignmentMorph newColumn.
+ 	soundColumn enableDragNDrop.
+ 	self addMorphBack: soundColumn!

Item was added:
+ ----- Method: SoundDemoMorph>>makeControls (in category 'as yet unclassified') -----
+ makeControls
+ 
+ 	| bb r cc |
+ 	cc _ Color black.
+ 	r _ AlignmentMorph newRow.
+ 	r color: cc; borderWidth: 0; layoutInset: 0.
+ 	r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5.
+ 	bb _ SimpleButtonMorph new target: self; borderColor: cc.
+ 	r addMorphBack: (bb label: 'V1';			actionSelector: #playV1).
+ 	bb _ SimpleButtonMorph new target: self; borderColor: cc.
+ 	r addMorphBack: (bb label: 'V2';			actionSelector: #playV2).
+ 	bb _ SimpleButtonMorph new target: self; borderColor: cc.
+ 	r addMorphBack: (bb label: 'V3';			actionSelector: #playV3).
+ 	bb _ SimpleButtonMorph new target: self; borderColor: cc.
+ 	r addMorphBack: (bb label: 'All';			actionSelector: #playAll).
+ 	bb _ SimpleButtonMorph new target: self; borderColor: cc.
+ 	r addMorphBack: (bb label: 'Stop';		actionSelector: #stopSound).
+ 	^ r
+ !

Item was added:
+ ----- Method: SoundDemoMorph>>playAll (in category 'as yet unclassified') -----
+ playAll
+ 	| snd |
+ 	soundColumn submorphs isEmpty
+ 		ifTrue: [^ self].
+ 	self setTimbreFromTile: soundColumn submorphs first.
+ 	snd _ SampledSound bachFugueVoice1On: SampledSound new.
+ 	soundColumn submorphs size >= 2
+ 		ifTrue: [""self setTimbreFromTile: soundColumn submorphs second.
+ 			snd _ snd
+ 						+ (AbstractSound bachFugueVoice2On: SampledSound new)].
+ 	soundColumn submorphs size >= 3
+ 		ifTrue: [""self setTimbreFromTile: soundColumn submorphs third.
+ 			snd _ snd
+ 						+ (AbstractSound bachFugueVoice3On: SampledSound new)].
+ 	snd play!

Item was added:
+ ----- Method: SoundDemoMorph>>playV1 (in category 'as yet unclassified') -----
+ playV1
+ 	soundColumn submorphs isEmpty
+ 		ifTrue: [^ self].
+ 	self
+ 		setTimbreFromTile: (soundColumn submorphs first).
+ 	(SampledSound bachFugueVoice1On: SampledSound new) play!

Item was added:
+ ----- Method: SoundDemoMorph>>playV2 (in category 'as yet unclassified') -----
+ playV2
+ 	soundColumn submorphs size < 2
+ 		ifTrue: [^ self].
+ 	self
+ 		setTimbreFromTile: (soundColumn submorphs second).
+ 	(SampledSound bachFugueVoice2On: SampledSound new) playSilentlyUntil: 4.8;
+ 		 resumePlaying!

Item was added:
+ ----- Method: SoundDemoMorph>>playV3 (in category 'as yet unclassified') -----
+ playV3
+ 	soundColumn submorphs size < 3
+ 		ifTrue: [^ self].
+ 	self
+ 		setTimbreFromTile: (soundColumn submorphs third).
+ 	(AbstractSound bachFugueVoice3On: SampledSound new) playSilentlyUntil: 14.4;
+ 		 resumePlaying!

Item was added:
+ ----- Method: SoundDemoMorph>>setTimbreFromTile: (in category 'as yet unclassified') -----
+ setTimbreFromTile: aSoundTile
+ 
+ 	SampledSound defaultSampleTable: aSoundTile sound samples.
+ 	SampledSound nominalSamplePitch: 400.
+ !

Item was added:
+ ----- Method: SoundDemoMorph>>stopSound (in category 'as yet unclassified') -----
+ stopSound
+ 
+ 	SoundPlayer shutDown.
+ !

Item was added:
+ ----- Method: SoundEventMorph>>sound (in category '*Etoys-Squeakland-other') -----
+ sound
+ 	"Answer the sound."
+ 
+ 	^ sound!

Item was added:
+ AlignmentMorph subclass: #SoundLibraryTool
+ 	instanceVariableNames: 'listBox button soundIndex currentSound showCompression'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sound-Interface'!
+ 
+ !SoundLibraryTool commentStamp: 'sw 10/20/2007 01:54' prior: 0!
+ A tool for browsing and managing the sound library.
+ Offers a self-updating, scrolling list of all the sounds in the library.  
+ Has a row of buttons to initiate various functions on the selected sound; the buttons are:
+ 	Play	Play the selected sound
+ 	Stop		Stop playing selected sound (if it is playing)
+ 	Tile		Hand the user a tile for the selected sound.
+ 	Rename	Rename the selected sound.
+ 	Delete	Delete the selected sound from the ibrary
+ 	Load	Load a sound into the sound library from a file.
+ 
+ Additionally, a wave-editor can be invoked via an item in the tool's halo menu.
+ 
+ The Sound Library tool can be launched from the Objects catalog, and also from the authoring-tools menu!

Item was added:
+ ----- Method: SoundLibraryTool class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	"Answer a description of the receiver for use in a parts bin"
+ 
+ 	^ self partName:	'Sound Library' translatedNoop
+ 		categories:		{'Multimedia' translatedNoop}
+ 		documentation:	'A tool for managing the sound library' translatedNoop!

Item was added:
+ ----- Method: SoundLibraryTool>>addButtonRow (in category 'initialization') -----
+ addButtonRow
+ 	"Add the row of control buttons."
+ 
+ 	| row aButton |
+ 	row := AlignmentMorph newRow vResizing: #shrinkWrap;
+ 				 color: Color transparent.
+ 
+ 	#(('Play' play 'Play the selected sound')
+ 		('Stop' pause 'If the selected sound is playing, stop it')
+ 		('Tile' handMeATile 'Hands you a tile representing the selected sound')
+ 		('Rename' renameSound 'Rename the selected sound')
+ 		('Delete' deleteSound 'Delete the selected sound from the sound library')
+ 		('Load' loadSoundFromDisk 'Add a new sound to the sound library from a file')) 
+ 			translatedNoop do:
+ 
+ 		[:triplet |
+ 			 row addVariableTransparentSpacer.
+ 			aButton := SimpleButtonMorph new label: triplet first translated font: ScriptingSystem fontForEToyButtons;
+ 				 target: self;
+ 				 actionSelector: triplet second.
+ 			aButton setBalloonText: triplet third translated.
+ 			row addMorphBack: aButton].
+ 
+ 	row addVariableTransparentSpacer.
+ 	self addMorphBack: row!

Item was added:
+ ----- Method: SoundLibraryTool>>addCustomMenuItems:hand: (in category 'menu') -----
+ addCustomMenuItems: aMenu hand: aHand
+ 	"Add custom menu items to a menu"
+ 
+ 	super addCustomMenuItems: aMenu hand: aHand.
+ 	aMenu addUpdating: #showCompressionString target: self action: #toggleShowCompression.
+ 	aMenu add: 'GSM compress sound' translated target: self selector: #compressWith: argument: GSMCodec.
+ 	aMenu add: 'Ogg Vorbis compress sound' translated target: self selector: #compressWith: argument:  OggVorbisCodec.
+ 	aMenu add: 'Ogg Speex compress sound' translated target: self selector: #compressWith: argument:  OggSpeexCodec.
+ 	aMenu addTranslatedList: #(
+ 		('Wave editor' edit 'open a tool which, operating with the selected sound as a point of departure, will allow you to construct a new "instrument"')
+ 	) translatedNoop
+ !

Item was added:
+ ----- Method: SoundLibraryTool>>addHeaderRow (in category 'initialization') -----
+ addHeaderRow
+ 	"Add the first row of the tool, containing dismiss and help icons and the interim name of the sound."
+ 
+ 	| aMorph |
+ 	aMorph := AlignmentMorph newRow.
+ 	aMorph hResizing: #spaceFill.
+ 	aMorph addMorphBack: self dismissButton.
+ 	aMorph addVariableTransparentSpacer.
+ 	aMorph addMorphBack: (StringMorph contents: 'Sound Library' translated font: ScriptingSystem fontForEToyButtons).
+ 	aMorph addVariableTransparentSpacer.
+ 	aMorph  addMorphBack: self helpButton.
+ 	self addMorphBack: aMorph!

Item was added:
+ ----- Method: SoundLibraryTool>>addSoundList (in category 'initialization') -----
+ addSoundList
+ 	"Add the sounds list to the tool."
+ 	
+ 	listBox _ PluggableMultiColumnListMorph
+ 				on: self
+ 				list: #listing
+ 				selected: #soundIndex
+ 				changeSelected: #soundIndex:.
+ 	listBox hResizing: #spaceFill.
+ 	
+ 	listBox hideMenuButton.
+ 	listBox height: 240.
+ 	listBox font: Preferences standardEToysFont.
+ 	self  addMorphBack: listBox!

Item was added:
+ ----- Method: SoundLibraryTool>>compressWith: (in category 'menu') -----
+ compressWith: aCodec 
+ 	"Compress the sound."
+ 	| newSound name writer |
+ 	soundIndex = 0
+ 		ifTrue: [^ self inform: 'No sound selected' translated].
+ 	
+ 	(SampledSound universalSoundKeys includes: self soundName)
+ 		ifTrue: [^ self inform: 'You can not compress this sound' translated].
+ 	newSound := currentSound compressWith: aCodec.
+ 	writer := ByteArray new writeStream.
+ 	newSound channels
+ 		do: [:channel | writer nextPutAll: channel].
+ 	name := self soundName.
+ 	SampledSound removeSoundNamed: self soundName.
+ 	SampledSound
+ 		addLibrarySoundNamed: name
+ 		bytes: writer contents
+ 		codecSignature: newSound codecSignature.
+ 	currentSound := SampledSound soundNamed: name.
+ 	self update!

Item was added:
+ ----- Method: SoundLibraryTool>>deleteSound (in category 'menu') -----
+ deleteSound
+ 	"Delete the selected sound, if appropriate."
+ 
+ 	 
+ 	soundIndex = 0
+ 		ifTrue: [^ self inform: 'No sound selected' translated].
+ 	currentSound pause.
+ 	(SampledSound universalSoundKeys includes: self soundName)
+ 		ifTrue: [^self inform: 'You can not delete this sound' translated]
+ 		ifFalse: [ScriptingSystem removeFromSoundLibrary: self soundName].
+ 	self soundIndex: 0.
+ 	self update!

Item was added:
+ ----- Method: SoundLibraryTool>>edit (in category 'menu') -----
+ edit
+ 	"Open a WaveEditor on my samples."
+ 	"Use the new ScratchSoundEditor if we can"
+ 	soundIndex > 0
+ 		ifTrue: [
+ 			Smalltalk globals at: #ScratchSoundEditor
+ 				ifPresent: [:c |  (c new sound: currentSound) openInWorld]
+ 				ifAbsent: [WaveEditor openOn: currentSound samples]].
+ !

Item was added:
+ ----- Method: SoundLibraryTool>>handMeATile (in category 'menu') -----
+ handMeATile 
+ 	| tile |
+ 	soundIndex = 0 ifTrue:[^nil].
+ 	tile _ SoundTile new literal: self soundName.
+ 		tile bounds: tile fullBounds.
+ 		tile openInHand!

Item was added:
+ ----- Method: SoundLibraryTool>>handlesMouseOver: (in category 'accessing') -----
+ handlesMouseOver: evt
+ 	"Do I want to receive mouseEnter: and mouseLeave: when the button is up and the hand is empty?  The default response is false, except if you have added sensitivity to mouseEnter: or mouseLeave:, using the on:send:to: mechanism."
+ 
+ 	^ true!

Item was added:
+ ----- Method: SoundLibraryTool>>helpString (in category 'initialization') -----
+ helpString
+ 	"Answer help content."
+ 
+ 	^ 'This tool allows you to view and manage the "Sound Library", which is the list of named sounds that can be used in the tile-scripting system.
+ 
+ Click on a sound name in the list to select it.  The buttons at the top of the tool apply to the sound you have selected.
+ 
+ Play button -- press this to start playing the selected sound.
+ 
+ Stop button -- if the selected sound is playing, pressing this will stop it.
+ 
+ Tile button -- Click on this to obtain a scripting tile representing the selected sound.
+ 
+ Rename button -- allows you to rename the selected sound.
+ 
+ Delete button -- allows you to delete the selected sound from the Sound Library.  All tiles that formerly pointed to this sound will be changed to point to "croak" instead.
+ 
+ Load button -- allows you to load a sound into the Sound Library from a file.
+ 
+ You can also add sounds to the Sound library using the Sound Recorder, and also by dragging an external sound file (e.g. a file with extensions .wav or .aif)  into etoys.
+ 
+ Note: the "universal" sounds built in to the system cannot be renamed or deleted.
+ 
+ Additionally, a command for opening a "wave editor" tool on the selected sound can be found in the tool''s halo menu.'
+ 
+ 	translated!

Item was added:
+ ----- Method: SoundLibraryTool>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 
+ 	super initialize.
+ 	showCompression _ false.
+ 	self hResizing: #shrinkWrap;
+ 		 vResizing: #shrinkWrap.
+ 	self cellPositioning: #topLeft.
+ 	self listDirection: #topToBottom.
+ 	self borderWidth: 2;
+ 		 borderColor: Color black.
+ 	self addHeaderRow.
+ 
+ 	self addButtonRow.
+ 	soundIndex := 1.
+ 	self addSoundList.
+ 	self soundIndex: 1.
+ 	self on: #mouseEnter send: #verifyContents to: listBox!

Item was added:
+ ----- Method: SoundLibraryTool>>listing (in category 'initialization') -----
+ listing
+ 	| list newList format soundData selectorList formatList |
+ 	list := SampledSound soundLibrary keys asSortedArray.
+ 	selectorList := OrderedCollection new.
+ 	formatList _ OrderedCollection new.
+ 	list
+ 		do: [:each | 
+ 			soundData := (SampledSound soundLibrary at: each) second.
+ 			soundData isNumber
+ 				ifTrue: [format := 'uncompressed']
+ 				ifFalse: [(soundData includesSubString: 'Vorbis')
+ 						ifTrue: [format := 'Vorbis']
+ 						ifFalse: [(soundData includesSubString: 'Speex')
+ 								ifTrue: [format := 'Speex']
+ 								ifFalse: [(soundData includesSubString: 'GSM')
+ 										ifTrue: [format := 'GSM']]]].
+ 			selectorList add: each.
+ 			formatList add:  format].
+ 	 newList _ OrderedCollection new.
+ 	newList add: selectorList asArray.
+ 	showCompression
+ 		ifTrue:[newList add: formatList asArray]
+ 		ifFalse:[newList add:  (Array new: (formatList size) withAll:' ')].
+ 	^newList!

Item was added:
+ ----- Method: SoundLibraryTool>>loadSoundFromDisk (in category 'menu') -----
+ loadSoundFromDisk
+ 	"Put up a file chooser dialog inviting the user to import a sound file; accept it"
+ 
+ 	| aSound aName aFileStream fullName ext reply |
+ 	aFileStream := FileList2 modalFileSelectorForSuffixes: #(#AIFF #aiff #Wave #wav #wave ).
+ 	aFileStream
+ 		ifNil: [^ self].
+ 	fullName := aFileStream name.
+ 	('*.AIFF' match: fullName)
+ 		ifTrue: [aSound := SampledSound fromAIFFfileNamed: fullName]
+ 		ifFalse: [aSound := SampledSound fromWaveStream: aFileStream].
+ 	aFileStream close.
+ 	ext := FileDirectory extensionFor: fullName.
+ 	aName :=  (FileDirectory on: fullName) pathParts last.
+ 	ext size > 0 ifTrue:
+ 		[aName := aName copyFrom: 1 to: (aName size - (ext size + 1))].
+ 	
+ 	[reply := FillInTheBlank request: 'Please give a name for this sound' translated initialAnswer: aName.
+ 	reply isEmptyOrNil ifTrue: [^ self].
+ 	(SampledSound soundLibrary includesKey:  reply)
+ 		ifTrue:
+ 			[self inform: 'sorry, that name is already taken' translated.
+ 			false]
+ 		ifFalse:
+ 			[true]] whileFalse.
+ 	SampledSound addLibrarySoundNamed: reply samples: aSound samples samplingRate: aSound originalSamplingRate.
+ 	self update!

Item was added:
+ ----- Method: SoundLibraryTool>>pause (in category 'menu') -----
+ pause
+ 	soundIndex > 0
+ 		ifTrue: [currentSound pause]!

Item was added:
+ ----- Method: SoundLibraryTool>>play (in category 'menu') -----
+ play
+ 	soundIndex > 0
+ 		ifTrue: [currentSound play]!

Item was added:
+ ----- Method: SoundLibraryTool>>presentHelp (in category 'initialization') -----
+ presentHelp
+ 	"Sent when a Help button is hit; provide the user with some form of help for the tool at hand"
+ 
+ 	| aFlapTab |
+ 	aFlapTab := ScriptingSystem assureFlapOfLabel: 'Sound Library' translated withContents: self helpString.
+ 	aFlapTab showFlap!

Item was added:
+ ----- Method: SoundLibraryTool>>renameSound (in category 'menu') -----
+ renameSound
+ 	"Rename the selected sound, if appropriate."
+ 
+ 	| name newName |
+ 	name := self soundName.
+ 	soundIndex = 0
+ 		ifTrue: [^ self inform: 'No sound selected' translated].
+ 	(SampledSound universalSoundKeys includes: name)
+ 		ifTrue: [^ self inform: 'You can not rename this sound' translated].
+ 
+ 	newName := FillInTheBlank request: 'New name for ' translated, name initialAnswer: name.
+ 	(newName isEmptyOrNil or: [newName = name]) ifTrue: [^ self].
+ 	(SampledSound soundLibrary includesKey: newName) ifTrue:
+ 		[^ self inform: 'sorry, that name is already used.' translated].
+ 	ScriptingSystem renameSound: name newName: newName.
+ 	self update.
+ 	self soundIndex: (listBox getList indexOf: newName)!

Item was added:
+ ----- Method: SoundLibraryTool>>setExtentFromHalo: (in category 'miscellaneous') -----
+ setExtentFromHalo: anExtent
+ 	"The user has dragged the grow box such that the receiver's extent would be anExtent.  Do what's needed."
+ 
+ 	submorphs third height: ((anExtent y - (submorphs first height + submorphs second height + 8)))!

Item was added:
+ ----- Method: SoundLibraryTool>>showCompression (in category 'menu') -----
+ showCompression
+ 	^showCompression!

Item was added:
+ ----- Method: SoundLibraryTool>>showCompressionString (in category 'menu') -----
+ showCompressionString
+ 	^ (self showCompression
+ 		ifTrue: ['<yes>']
+ 		ifFalse: ['<no>'])
+ 		, 'show compression' translated!

Item was added:
+ ----- Method: SoundLibraryTool>>soundIndex (in category 'accessing') -----
+ soundIndex
+ 	 ^soundIndex!

Item was added:
+ ----- Method: SoundLibraryTool>>soundIndex: (in category 'accessing') -----
+ soundIndex: aInteger
+  	"Set the soundIndex to the given integer."
+ 
+ 	| |
+ 	soundIndex :=  aInteger.
+ 	soundIndex = 0
+ 		ifFalse:
+ 			[
+ 			currentSound :=  SampledSound soundNamed: self soundName]
+ 		ifTrue:
+ 			[currentSound := nil].
+ 	
+         self changed: #soundIndex.!

Item was added:
+ ----- Method: SoundLibraryTool>>soundList (in category 'accessing') -----
+ soundList
+ 	"Answer the list of sound keys in the sound library."
+ 
+ 	^ SampledSound soundLibrary keys asSortedArray!

Item was added:
+ ----- Method: SoundLibraryTool>>soundName (in category 'accessing') -----
+ soundName
+ 	soundIndex = 0 ifTrue:[^self].
+ 	^ (listBox getListRow: soundIndex) first!

Item was added:
+ ----- Method: SoundLibraryTool>>toggleShowCompression (in category 'menu') -----
+ toggleShowCompression
+ 	showCompression _ showCompression not.
+ 	self update!

Item was added:
+ ----- Method: SoundLibraryTool>>update (in category 'accessing') -----
+ update
+ 	self listing.
+ 	listBox updateList!

Item was added:
+ ImageMorph subclass: #SoundMorph
+ 	instanceVariableNames: 'sound'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sound-Interface'!
+ 
+ !SoundMorph commentStamp: '<historical>' prior: 0!
+ Note: as of December 2000, this does not work. SoundMorph>>buildImage requires the sound to implement #volumeEnvelopeScaledTo: and as yet, no one does.!

Item was added:
+ ----- Method: SoundMorph>>buildImage (in category 'as yet unclassified') -----
+ buildImage
+ 	| scale env h imageColor |
+ 	owner ifNil: [scale _ 128 at 128]  "Default is 128 pix/second, 128 pix fullscale"
+ 		ifNotNil: [scale _ owner soundScale].
+ 	env _ sound volumeEnvelopeScaledTo: scale.
+ 	self image: (ColorForm extent: env size @ env max).
+ 	1 to: image width do:
+ 		[:x | h _ env at: x.
+ 		image fillBlack: ((x-1)@(image height-h//2) extent: 1 at h)].
+ 	imageColor _ #(black red orange green blue) atPin:
+ 						(sound pitch / 110.0) rounded highBit.
+ 	image colors: (Array with: Color transparent with: (Color perform: imageColor)).
+ !

Item was added:
+ ----- Method: SoundMorph>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	super initialize.
+ 	self sound: (FMSound pitch: 880.0 dur: 0.2 loudness: 0.8).
+ !

Item was added:
+ ----- Method: SoundMorph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
+ justDroppedInto: aMorph event: anEvent
+ 	| relPosition |
+ 	relPosition _ self position - aMorph innerBounds topLeft.
+ 	relPosition _ (relPosition x roundTo: 8) @ relPosition y.
+ 	self position: aMorph innerBounds topLeft + relPosition.
+ 	sound copy play.
+ 	^super justDroppedInto: aMorph event: anEvent!

Item was added:
+ ----- Method: SoundMorph>>reset (in category 'as yet unclassified') -----
+ reset
+ 	sound reset!

Item was added:
+ ----- Method: SoundMorph>>sound (in category 'as yet unclassified') -----
+ sound
+ 	^ sound!

Item was added:
+ ----- Method: SoundMorph>>sound: (in category 'as yet unclassified') -----
+ sound: aSound
+ 	sound _ aSound copy.
+ 	sound reset.
+ 	self buildImage!

Item was added:
+ ----- Method: SoundPlayer class>>reverbChanged (in category '*Etoys-Squeakland-player process') -----
+ reverbChanged
+ 	Preferences soundReverb
+ 		ifTrue: [self startReverb]
+ 		ifFalse: [self stopReverb]
+ !

Item was added:
+ ----- Method: SoundReadoutTile>>choices (in category '*Etoys-Squeakland-arrows') -----
+ choices
+  ^self soundChoices.
+ !

Item was added:
+ ----- Method: SoundRecorder class>>stopRecording (in category '*Etoys-Squeakland-accessing') -----
+ stopRecording
+ 	self allInstancesDo: [:each | each stopRecording].!

Item was added:
+ ----- Method: SoundRecorder>>codec (in category '*Etoys-Squeakland-accessing') -----
+ codec
+ 	"Answer the receiver's codec"
+ 
+ 	^ codec!

Item was added:
+ ----- Method: SoundRecorder>>codecSignature (in category '*Etoys-Squeakland-accessing') -----
+ codecSignature
+ 	codec
+ 		ifNil: [^ nil].
+ 	^ recordedSound sounds first codecSignature!

Item was added:
+ ----- Method: SoundRecorder>>condensedChannels (in category '*Etoys-Squeakland-results') -----
+ condensedChannels
+ 	| writer |
+ 	writer := ByteArray new writeStream.
+ 	recordedSound sounds
+ 		do: [:sound | sound channels
+ 				do: [:channel | writer nextPutAll: channel]].
+ 	^ writer contents!

Item was added:
+ ----- Method: SoundRecorder>>primGetSwitch:captureFlag:channel: (in category '*Etoys-Squeakland-primitives') -----
+ primGetSwitch: id captureFlag: capture channel: channel
+ 
+ 	<primitive: 'primitiveSoundGetSwitch' module: 'SoundPlugin'>
+ 	^ -1!

Item was added:
+ ----- Method: SoundRecorder>>primSetDevice:name: (in category '*Etoys-Squeakland-primitives') -----
+ primSetDevice: anInteger name: aString
+ 
+ 	<primitive: 'primitiveSoundSetDevice' module: 'SoundPlugin'>
+ 	^ -1.
+ !

Item was added:
+ ----- Method: SoundRecorder>>primSetSwitch:captureFlag:parameter: (in category '*Etoys-Squeakland-primitives') -----
+ primSetSwitch: id captureFlag: capture parameter: parameter
+ 
+ 	<primitive: 'primitiveSoundSetSwitch' module: 'SoundPlugin'>
+ 	^ -1!

Item was added:
+ RectangleMorph subclass: #SoundSequencerMorph
+ 	instanceVariableNames: 'controlPanel'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sound-Interface'!

Item was added:
+ ----- Method: SoundSequencerMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	super initialize.
+ 	self extent: 550 at 350.
+ 	self makeControlPanel.
+ 	self addMorph: controlPanel.
+ 	self addMorph: ((SoundLoopMorph newBounds: (10 at 40 extent: 128 at 128)) extent: 128 at 128).
+ 	self addMorph: ((SoundLoopMorph newBounds: (10 at 200 extent: 512 at 128)) extent: 512 at 128).!

Item was added:
+ ----- Method: SoundSequencerMorph>>makeControlPanel (in category 'as yet unclassified') -----
+ makeControlPanel
+ 	| bb cc |
+ 	cc _ Color black.
+ 	bb _ SimpleButtonMorph new target: self; borderColor: cc.
+ 	controlPanel _ AlignmentMorph newRow.
+ 	bb _ SimpleButtonMorph new target: self; borderColor: cc.
+ 	controlPanel color: bb color; borderWidth: 0; layoutInset: 0.
+ 	controlPanel hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5 at 5.
+ 	bb _ SimpleButtonMorph new target: self; borderColor: cc.
+ 	controlPanel addMorphBack: (bb label: 'reset';	actionSelector: #reset).
+ 	bb _ SimpleButtonMorph new target: self; borderColor: cc.
+ 	controlPanel addMorphBack: (bb label: 'stop';		actionSelector: #stop).
+ 	bb _ SimpleButtonMorph new target: self; borderColor: cc.
+ 	controlPanel addMorphBack: (bb label: 'play';	actionSelector: #play).
+ !

Item was added:
+ ----- Method: SoundSequencerMorph>>play (in category 'as yet unclassified') -----
+ play
+ 	self submorphsDo: [:m | m == controlPanel ifFalse: [m play]]!

Item was added:
+ ----- Method: SoundSequencerMorph>>reset (in category 'as yet unclassified') -----
+ reset
+ 	self submorphsDo: [:m | m == controlPanel ifFalse: [m reset]]!

Item was added:
+ ----- Method: SoundSequencerMorph>>stop (in category 'stepping and presenter') -----
+ stop
+ 	self submorphsDo: [:m | m == controlPanel ifFalse: [m stop]].
+ 	SoundPlayer shutDown!

Item was added:
+ AlignmentMorph subclass: #SpectrumAnalyzerMorph
+ 	instanceVariableNames: 'soundInput statusLight levelMeter graphMorph sonogramMorph fft displayType'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sound-Interface'!
+ 
+ !SpectrumAnalyzerMorph commentStamp: '<historical>' prior: 0!
+ I am a tool for analyzing sound data from a microphone, CD, or other input source in real time. I have several display modes:
+ 
+ 	signal		snapshots of the raw signal data as it arrives
+ 	spectrum	frequency spectrum of the signal data as it arrives
+ 	sonogram	scrolling plot of the frequency spectrum over time,
+ 			      where the vertical axis is frequency, the horizontal
+ 				  axis is time, and amount of energy at a given
+ 				  frequency is shown as a grayscale value with
+ 				  larger values being darker
+ 
+ To use this tool, be sure that you have selected the proper sound source using you host OS facilities. Set the desired sampling rate and FFT size (try 22050 samples/sec and an FFT size of 512) then click on the 'start' button. Use the slider to adjust the level so that the yellow level indicator peaks somewhere between the middle and the right edge at the maximum signal level.
+ 
+ Note that if the level meter peaks hit the right edge, you will get 'clipping', which creates a bunch of spurious high frequency noise in the frequency spectrum. If the display is set to 'signal' mode, you can actually see the tops and bottoms of the waveform being cut off when clipping occurs.
+ 
+ Many machines may not be able to perform spectrum analysis in real time, especially at higher sampling rates and larger FFT sizes. In both 'signal' and 'spectrum' modes, this tool will skip data to try to keep up with real time. However, in 'sonogram' mode it always processes all the data, even if it falls behind. This allows you to get a complete sonogram without dropouts even on a slower machine. However, as the sonogram display falls behind there will be a larger and larger time lag between when a sound is input and when it appears on the display.
+ 
+ The smaller the FFT size, the less frequency resolution you get. The lower the sampling rate, the less total frequency range you get. For an FFT size of N and a sampling rate of R, each of the N/2 'bins' of the frequency spectrum has a frequency resolution of R / N. For example, at a sampleing rate of 22050 samples/second, the total frequency range is 0 to 11025 Hz and an FFT of size 256 would divide this range into 128 bins (the output of an FFT of size N has N/2 bins), each of which covers a frequency band about 86 Hz wide.
+ 
+ To increase time resolution, increase the sampling rate and decrease the FFT size.
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph class>>descriptionForPartsBin (in category 'as yet unclassified') -----
+ descriptionForPartsBin
+ 	^ self
+ 		partName: 'Spectrum Analyzer' translatedNoop
+ 		categories: {'Multimedia' translatedNoop}
+ 		documentation: 'A device for analyzing sound input' translatedNoop
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>addButtonRow (in category 'private') -----
+ addButtonRow
+ 
+ 	| r |
+ 	r _ AlignmentMorph newRow vResizing: #shrinkWrap.
+ 	r addMorphBack: (self buttonName: 'Menu' translated action: #invokeMenu).
+ 	r addMorphBack: (Morph new extent: 4 at 1; color: Color transparent).
+ 	r addMorphBack: (self buttonName: 'Start' translated action: #start).
+ 	r addMorphBack: (Morph new extent: 4 at 1; color: Color transparent).
+ 	r addMorphBack: (self buttonName: 'Stop' translated action: #stop).
+ 	r addMorphBack: (Morph new extent: 12 at 1; color: Color transparent).
+ 	self addMorphBack: r.
+ 	^ r fullBounds.
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>addLevelSlider (in category 'private') -----
+ addLevelSlider
+ 
+ 	| levelSlider r |
+ 	levelSlider _ SimpleSliderMorph new
+ 		color: color;
+ 		extent: 100 at 2;
+ 		target: soundInput;
+ 		actionSelector: #recordLevel:;
+ 		adjustToValue: soundInput recordLevel.
+ 	r _ AlignmentMorph newRow
+ 		color: color;
+ 		layoutInset: 0;
+ 		wrapCentering: #center; cellPositioning: #leftCenter;
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #rigid;
+ 		height: 24.
+ 	r addMorphBack: (StringMorph contents: '0 ').
+ 	r addMorphBack: levelSlider.
+ 	r addMorphBack: (StringMorph contents: ' 10').
+ 	self addMorphBack: r.
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>addLevelSliderIn: (in category 'private') -----
+ addLevelSliderIn: aPoint
+ 
+ 	| levelSlider r |
+ 	levelSlider _ SimpleSliderMorph new
+ 		color: color;
+ 		extent: (aPoint x * 0.75) asInteger@(aPoint y*0.6) asInteger;
+ 		target: soundInput;
+ 		actionSelector: #recordLevel:;
+ 		adjustToValue: soundInput recordLevel.
+ 	r _ AlignmentMorph newRow
+ 		color: color;
+ 		layoutInset: 0;
+ 		wrapCentering: #center; cellPositioning: #leftCenter;
+ 		hResizing: #shrinkWrap;
+ 		vResizing: #rigid;
+ 		height: aPoint y + 2.
+ 	r addMorphBack: (StringMorph contents: '0 ' font: Preferences standardEToysButtonFont).
+ 	r addMorphBack: levelSlider.
+ 	r addMorphBack: (StringMorph contents: ' 10' font: Preferences standardEToysButtonFont).
+ 	self addMorphBack: r.
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>buttonName:action: (in category 'private') -----
+ buttonName: aString action: aSymbol
+ 
+ 	^ SimpleButtonMorph new
+ 		target: self;
+ 		label: aString font: Preferences standardEToysButtonFont;
+ 		actionSelector: aSymbol
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>defaultBorderWidth (in category 'initialization') -----
+ defaultBorderWidth
+ "answer the default border width for the receiver"
+ 	^ 2!

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>delete (in category 'submorphs-add/remove') -----
+ delete
+ 	"Turn off recording when this morph is deleted."
+ 
+ 	super delete.
+ 	soundInput stopRecording.
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>initialize (in category 'initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ 	| full |
+ 	super initialize.
+ ""
+ 	self listDirection: #topToBottom.
+ 	soundInput _ SoundInputStream new samplingRate: 22050.
+ 	fft _ FFT new: 512.
+ 	displayType _ 'sonogram'.
+ 	self hResizing: #shrinkWrap.
+ 	self vResizing: #shrinkWrap.
+ 	full := self addButtonRow.
+ 	submorphs last addMorphBack: (self makeStatusLightIn: full extent).
+ 
+ 	self addLevelSliderIn: full extent.
+ 	self addMorphBack: (self makeLevelMeterIn: full extent).
+ 	self addMorphBack: (Morph new extent: 10 @ 10;
+ 			 color: Color transparent).
+ 	"spacer"
+ 	self resetDisplay!

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>invokeMenu (in category 'menu and buttons') -----
+ invokeMenu
+ 	"Invoke the settings menu."
+ 
+ 	| aMenu |
+ 	aMenu _ CustomMenu new.
+ 	aMenu addList:	{
+ 		{'set sampling rate' translated.		#setSamplingRate}.
+ 		{'set FFT size' translated.			#setFFTSize}.
+ 		{'set display type' translated.		#setDisplayType}}.
+ 	aMenu invokeOn: self defaultSelection: nil.
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>makeLevelMeter (in category 'private') -----
+ makeLevelMeter
+ 
+ 	| outerBox |
+ 	outerBox _ RectangleMorph new extent: 125 at 14; color: Color lightGray.
+ 	levelMeter _ Morph new extent: 2 at 10; color: Color yellow.
+ 	levelMeter position: outerBox topLeft + (2 at 2).
+ 	outerBox addMorph: levelMeter.
+ 	^ outerBox
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>makeLevelMeterIn: (in category 'private') -----
+ makeLevelMeterIn: aPoint
+ 
+ 	| outerBox h |
+ 	h := (aPoint y * 0.6) asInteger.
+ 	outerBox _ Morph new extent: (aPoint x) asInteger at h; color: Color gray.
+ 	levelMeter _ Morph new extent: 1 at h; color: Color yellow.
+ 	levelMeter position: outerBox topLeft + (1 at 1).
+ 	outerBox addMorph: levelMeter.
+ 	^ outerBox
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>makeStatusLight (in category 'private') -----
+ makeStatusLight
+ 
+ 	| s |
+ 	statusLight _ RectangleMorph new extent: 24 at 19.
+ 	statusLight color: Color gray.
+ 	s _ StringMorph contents: 'On' translated.
+ 	s position: statusLight center - (s extent // 2).
+ 	statusLight addMorph: s.
+ 	^ statusLight
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>makeStatusLightIn: (in category 'private') -----
+ makeStatusLightIn: aPoint
+ 
+ 	| s p |
+ 	p _ (aPoint x min: aPoint y) asPoint.
+ 	statusLight _ RectangleMorph new extent: p.
+ 	statusLight color: Color gray.
+ 	s _ StringMorph contents: 'On' translated font: Preferences standardEToysFont.
+ 	s position: statusLight center - (s extent // 2).
+ 	statusLight addMorph: s.
+ 	^ statusLight
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>processBuffer: (in category 'private') -----
+ processBuffer: buf 
+ 	"Analyze one buffer of data."
+ 
+ 	| data |
+ 	data := displayType = 'signal' 
+ 		ifTrue: [buf]
+ 		ifFalse: [fft transformDataFrom: buf startingAt: 1].
+ 	graphMorph ifNotNil: 
+ 			[graphMorph
+ 				data: data;
+ 				changed].
+ 	sonogramMorph ifNotNil: 
+ 			[data := data collect: [:v | v sqrt].	"square root compresses dynamic range"
+ 			data /= 400.0.
+ 			sonogramMorph plotColumn: (data copyFrom: 1 to: data size // 1)]!

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>removeAllDisplays (in category 'private') -----
+ removeAllDisplays
+ 	"Remove all currently showing displays."
+ 
+ 	sonogramMorph ifNotNil: [sonogramMorph delete].
+ 	graphMorph ifNotNil: [graphMorph delete].
+ 	sonogramMorph _ graphMorph _ nil.
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>resetDisplay (in category 'menu and buttons') -----
+ resetDisplay
+ 	"Recreate my display after changing some parameter such as FFT size."
+ 
+ 	displayType = 'signal' ifTrue: [self showSignal].
+ 	displayType = 'spectrum' ifTrue: [self showSpectrum].
+ 	displayType = 'sonogram' ifTrue: [self showSonogram].
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>setDisplayType (in category 'menu and buttons') -----
+ setDisplayType
+ 	"Set the display type."
+ 
+ 	| aMenu choice on |
+ 	aMenu _ CustomMenu new title: ('display type (currently {1})' translated format:{displayType}).
+ 	aMenu addList:	{
+ 		{'signal' translated.	'signal'}.
+ 		{'spectrum' translated.	'spectrum'}.
+ 		{'sonogram' translated.	'sonogram'}}.
+ 	choice _ aMenu startUp.
+ 	choice ifNil: [^ self].
+ 
+ 	on _ soundInput isRecording.
+ 	self stop.
+ 	displayType _ choice.
+ 	self resetDisplay.
+ 	on ifTrue: [self start].
+ 
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>setFFTSize (in category 'menu and buttons') -----
+ setFFTSize
+ 	"Set the size of the FFT used for frequency analysis."
+ 
+ 	| aMenu sz on |
+ 	aMenu _ CustomMenu new title: ('FFT size (currently {1})' translated format:{fft n}).
+ 	((7 to: 10) collect: [:n | 2 raisedTo: n]) do:[:r | aMenu add: r printString action: r].
+ 	sz _ aMenu startUp.
+ 	sz ifNil: [^ self].
+ 	on _ soundInput isRecording.
+ 	self stop.
+ 	fft _ FFT new: sz.
+ 	self resetDisplay.
+ 	on ifTrue: [self start].
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>setSamplingRate (in category 'menu and buttons') -----
+ setSamplingRate
+ 	"Set the sampling rate to be used for incoming sound data."
+ 
+ 	| aMenu rate on |
+ 	aMenu _ CustomMenu new title:
+ 		('Sampling rate (currently {1})' translated format:{soundInput samplingRate}).
+ 	#(11025 22050 44100) do:[:r | aMenu add: r printString action: r].
+ 	rate _ aMenu startUp.
+ 	rate ifNil: [^ self].
+ 	on _ soundInput isRecording.
+ 	self stop.
+ 	soundInput samplingRate: rate.
+ 	self resetDisplay.
+ 	on ifTrue: [self start].
+ 
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>showSignal (in category 'private') -----
+ showSignal
+ 	"Display the actual signal waveform."
+ 
+ 	displayType _ 'signal'.
+ 	self removeAllDisplays.
+ 	graphMorph _ GraphMorph new.
+ 	graphMorph extent: (400 + (2 * graphMorph borderWidth))@128.
+ 	graphMorph data: (Array new: 100 withAll: 0).
+ 	graphMorph color: (Color r: 0.8 g: 1.0 b: 1.0).
+ 	self addMorphBack: graphMorph.
+ 	self extent: 10 at 10.  "shrink to minimum size"
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>showSonogram (in category 'private') -----
+ showSonogram
+ 	"Display a sonogram showing the frequency spectrum versus time."
+ 
+ 	| zeros h w |
+ 	displayType _ 'sonogram'.
+ 	self removeAllDisplays.
+ 	h _ fft n // 2.
+ 	h _ h min: 512 max: 64.
+ 	w _ 400.
+ 	sonogramMorph _
+ 		Sonogram new
+ 			extent: w at h
+ 			minVal: 0.0
+ 			maxVal: 1.0
+ 			scrollDelta: w.
+ 	zeros _ Array new: sonogramMorph height withAll: 0.
+ 	sonogramMorph width timesRepeat: [sonogramMorph plotColumn: zeros].
+ 	self addMorphBack: sonogramMorph.
+ 	self extent: 10 at 10.  "shrink to minimum size"
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>showSpectrum (in category 'private') -----
+ showSpectrum
+ 	"Display the frequency spectrum."
+ 
+ 	displayType _ 'spectrum'.
+ 	self removeAllDisplays.
+ 	graphMorph _ GraphMorph new.
+ 	graphMorph extent: ((fft n // 2) + (2 * graphMorph borderWidth))@128.
+ 	graphMorph data: (Array new: fft n // 2 withAll: 0).
+ 	self addMorphBack: graphMorph.
+ 	self extent: 10 at 10.  "shrink to minimum size"
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>start (in category 'stepping and presenter') -----
+ start
+ 	"Start displaying sound data."
+ 
+ 	displayType = 'signal'
+ 		ifTrue: [soundInput bufferSize: graphMorph width - (2 * graphMorph borderWidth)]
+ 		ifFalse: [soundInput bufferSize: fft n].
+ 	soundInput startRecording.
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>step (in category 'stepping and presenter') -----
+ step
+ 	"Update the record light, level meter, and display."
+ 
+ 	| w |
+ 	"update the record light and level meter"
+ 	soundInput isRecording
+ 		ifTrue: [statusLight color: Color yellow]
+ 		ifFalse: [statusLight color: Color gray].
+ 	w _ ((121 * soundInput meterLevel) // 100) max: 1.
+ 	levelMeter width ~= w ifTrue: [levelMeter width: w].
+ 
+ 	"update the display if any data is available"
+ 	self updateDisplay.
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>stepTime (in category 'testing') -----
+ stepTime
+ 
+ 	^ 0
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>stop (in category 'stepping and presenter') -----
+ stop
+ 	"Stop displaying sound data."
+ 
+ 	soundInput stopRecording.
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>stopStepping (in category 'stepping and presenter') -----
+ stopStepping
+ 	"Turn off recording."
+ 
+ 	super stopStepping.
+ 	soundInput stopRecording.
+ !

Item was added:
+ ----- Method: SpectrumAnalyzerMorph>>updateDisplay (in category 'private') -----
+ updateDisplay
+ 	"Update the display if any data is available."
+ 
+ 	| buf bufCount |
+ 	soundInput bufferCount = 0 ifTrue: [^ self].
+ 
+ 	graphMorph ifNotNil: [
+ 		[soundInput bufferCount > 0] whileTrue: [
+ 			"skip to the most recent buffer"
+ 			buf _ soundInput nextBufferOrNil].
+ 		^ self processBuffer: buf].
+ 
+ 	sonogramMorph ifNotNil: [
+ 		"at small buffer sizes we have to update the sonogram in
+ 		 batches or we may get behind; shoot for 8 updates/second"
+ 		bufCount _ (soundInput samplingRate / (8 * soundInput bufferSize)) truncated max: 1.
+ 		[bufCount > 0 and: [soundInput bufferCount > 0]] whileTrue: [
+ 			self processBuffer: (soundInput nextBufferOrNil)]].
+ !

Item was added:
+ Morph subclass: #SpeechBubbleMorph
+ 	instanceVariableNames: 'type balloon tail target lastHash stepTime msgMorph'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-SpeechBubbles'!
+ SpeechBubbleMorph class
+ 	instanceVariableNames: 'speakingForm topLeftCornerForm thinkingForm'!
+ SpeechBubbleMorph class
+ 	instanceVariableNames: 'speakingForm topLeftCornerForm thinkingForm'!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>additionsToViewerCategoryBubble (in category 'viewer categories') -----
+ additionsToViewerCategoryBubble
+ 	"Answer viewer additions for the 'bubble' category"
+ 
+ 	^#(
+ 		bubble 
+ 		(
+ 			(command attachTo: 'Make the bubble follow an object' Player)
+ 			(command stopAttaching 'Free the bubble from following an object')
+ 			(slot attachment 'The object this bubble is currently following' Player readOnly Player getAttachment Player unused)		
+ 		)
+ 	)
+ !

Item was added:
+ ----- Method: SpeechBubbleMorph class>>bottomLeftCornerForm (in category 'forms') -----
+ bottomLeftCornerForm
+ ^self topLeftCornerForm flipBy: #vertical centerAt: self topLeftCornerForm boundingBox topCenter!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>bottomRightCornerForm (in category 'forms') -----
+ bottomRightCornerForm
+ ^(self topLeftCornerForm flipBy: #horizontal centerAt: self topLeftCornerForm boundingBox leftCenter) flipBy: #vertical centerAt: self topLeftCornerForm boundingBox topCenter!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>form:type: (in category 'instance creation') -----
+ form: aForm type: aSymbol
+ ^(self basicNew setMorph: (SketchMorph withForm: aForm) type: aSymbol) initialize!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>form:type:for: (in category 'instance creation') -----
+ form: aForm type: aSymbol for: aMorph
+ ^(self form: aForm type: aSymbol) target: aMorph!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>morph:type: (in category 'instance creation') -----
+ morph: aMorph type: aSymbol 
+ ^(self basicNew setMorph: aMorph type: aSymbol) initialize!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>morph:type:for: (in category 'instance creation') -----
+ morph: aMorph type: aSymbol for: targetMorph
+ ^(self morph: aMorph type: aSymbol) target: targetMorph!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>new (in category 'instance creation') -----
+ new
+ 	^self string: 'Hello world!!'!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>speakingForm (in category 'forms') -----
+ speakingForm
+ "
+ speakingForm := nil
+ "
+ ^speakingForm ifNil: [speakingForm := (Form
+ 	extent: 56 at 51
+ 	depth: 16
+ 	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 98303 2147450879 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 98303 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 98303 2147450879 2147450879 2147418113 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 65537 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 98303 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 98303 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 65537 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
+ 	offset: 0 at 0)]!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>speechGraphicPrototype (in category 'parts bin') -----
+ speechGraphicPrototype
+ 	^self form: (ScriptingSystem formAtKey: 'Painting') type: #speech!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>speechPrototype (in category 'parts bin') -----
+ speechPrototype
+ 	^self string: 'Hello world!!' type: #speech!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>string: (in category 'instance creation') -----
+ string: aString 
+ ^self string: aString type: #speech!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>string:type: (in category 'instance creation') -----
+ string: aString type: aSymbol
+ "self string: 'Hello world!!' type: #speech"
+ | text instance |
+ text := (UserText new contents: aString) centered.
+ text width > 300 ifTrue: [text contents: aString wrappedTo: 300].
+ text on: #keyStroke send: #keyStroke:morph: to: (instance := self basicNew).
+ ^(instance setMorph: text type: aSymbol) initialize!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>string:type:for: (in category 'instance creation') -----
+ string: aString type: aSymbol for: aMorph
+ "self string: 'Hello world!!' type: #speech for: Morph new openInHand"
+ ^(self string: aString type: aSymbol) target: aMorph!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>supplementaryPartsDescriptions (in category 'parts bin') -----
+ 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: 'Speech bubble' translatedNoop
+ 		categoryList: #('Just for Fun')
+ 		documentation: 'An object you can use to make words represent the speech of a character in a comic' translatedNoop
+ 		globalReceiverSymbol: #SpeechBubbleMorph
+ 		nativitySelector: #speechPrototype.
+ 
+ 	DescriptionForPartsBin
+ 		formalName: 'Thought bubble' translatedNoop
+ 		categoryList: #('Just for Fun')
+ 		documentation: 'An object you can use to make words represent the thoughts of a character in a comic' translatedNoop
+ 		globalReceiverSymbol: #SpeechBubbleMorph
+ 		nativitySelector: #thoughtPrototype.
+ 
+ 	DescriptionForPartsBin
+ 		formalName: 'Speech bubble (graphic)' translatedNoop
+ 		categoryList: #('Just for Fun')
+ 		documentation: 'An object you can use to make pictures represent the speech of a character in a comic' translatedNoop
+ 		globalReceiverSymbol: #SpeechBubbleMorph
+ 		nativitySelector: #speechGraphicPrototype.
+ 
+ 	DescriptionForPartsBin
+ 		formalName: 'Thought bubble (graphic)' translatedNoop
+ 		categoryList: #('Just for Fun')
+ 		documentation: 'An object you can use to make pictures represent the thoughts of a character in a comic' translatedNoop
+ 		globalReceiverSymbol: #SpeechBubbleMorph
+ 		nativitySelector: #thoughtGraphicPrototype.
+ }
+ !

Item was added:
+ ----- Method: SpeechBubbleMorph class>>thinkingForm (in category 'forms') -----
+ thinkingForm
+ "
+ thinkingForm := nil
+ thinkingForm
+ "
+ ^thinkingForm ifNil: [thinkingForm := (Form
+ 	extent: 56 at 49
+ 	depth: 16
+ 	fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 65537 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 65537 65537 65537 65537 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 65537 65537 2147450879 2147450879 2147450879 65537 65537 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 1 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 1 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 1 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 65537 65537 65537 0 0 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 1 65537 65537 65537 65537 65537 0 1 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 65537 65537 98303 2147450879 2147418113 65537 65537 0 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147418113 65537 65536 1 65537 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 65536 0 0 0 0 0 0 0 0 1 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65536 0 65537 65537 65537 2147450879 2147450879 2147450879 65537 65537 65537 0 0 0 0 0 0 0 0 0 1 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65536 0 0 1 65537 65537 65537 65537 65537 65537 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 1 65537 65537 65537 65536 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147418113 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 98303 2147450879 2147450879 2147450879 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 65537 65536 0 1 65537 98303 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 65537 65537 65537 65536 0 65537 65537 98303 2147450879 2147418113 65537 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 2147450879 65537 65536 0 0 65537 65537 65537 65537 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 2147418113 65537 0 0 0 65537 65537 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 2147450879 2147450879 2147450879 2147450879 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 65537 98303 2147450879 2147450879 2147418113 65537 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 2147450879 2147450879 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 65537 65537 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 65537 65537 65536 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
+ 	offset: 0 at 0)]!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>thoughtGraphicPrototype (in category 'parts bin') -----
+ thoughtGraphicPrototype
+ 	^self form: (ScriptingSystem formAtKey: 'Painting') type: #thought!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>thoughtPrototype (in category 'parts bin') -----
+ thoughtPrototype
+ 	^self string: 'Hello world!!' type: #thought!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>topLeftCornerForm (in category 'forms') -----
+ topLeftCornerForm
+ "
+ topLeftCornerForm := nil
+ (SketchMorph withForm: topLeftCornerForm) openInHand
+ "
+ ^topLeftCornerForm ifNil: [topLeftCornerForm := (Form
+ 	extent: 25 at 25
+ 	depth: 16
+ 	fromArray: #( 0 0 0 0 0 0 0 1 65537 65537 65537 65537 65536 0 0 0 0 0 1 65537 65537 65537 65537 65537 65537 65536 0 0 0 0 1 65537 65537 65537 2147450879 2147450879 2147450879 2147450879 2147418112 0 0 0 1 65537 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 0 0 0 65537 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 0 0 1 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 0 0 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 0 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 0 1 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 0 1 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 0 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 0 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 1 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 1 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 1 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 1 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 65537 98303 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112 65537 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147450879 2147418112)
+ 	offset: 0 at 0)]!

Item was added:
+ ----- Method: SpeechBubbleMorph class>>topRightCornerForm (in category 'forms') -----
+ topRightCornerForm
+ ^self topLeftCornerForm flipBy: #horizontal centerAt:  self topLeftCornerForm boundingBox leftCenter!

Item was added:
+ ----- Method: SpeechBubbleMorph>>balloon (in category 'accessing') -----
+ balloon
+ 	^balloon ifNil: [
+ 		| balloonForm |
+ 		balloonForm := Form extent: self extent - (0 @ self tailHeight) depth: 16.
+ 		self drawBalloonOn: balloonForm getCanvas in: balloonForm boundingBox.
+ 		balloonForm floodFill: self color at: balloonForm center.
+ 		balloon := (SketchMorph withForm: balloonForm).
+ 	]!

Item was added:
+ ----- Method: SpeechBubbleMorph>>color: (in category 'accessing') -----
+ color: aColor
+ 	super color: aColor.
+ 	self refresh!

Item was added:
+ ----- Method: SpeechBubbleMorph>>containsPoint: (in category 'testing') -----
+ containsPoint: aPoint
+ ^ (self bounds containsPoint: aPoint) and:
+ 	  [(self imageForm isTransparentAt: aPoint - bounds origin) not]
+ !

Item was added:
+ ----- Method: SpeechBubbleMorph>>defaultColor (in category 'accessing') -----
+ defaultColor
+ 	^Color white!

Item was added:
+ ----- Method: SpeechBubbleMorph>>delete (in category 'initialize-release') -----
+ delete
+ 	target isMorph ifTrue: [target bubble: nil].
+ 	super delete.
+ 	target := msgMorph := type := nil.
+ !

Item was added:
+ ----- Method: SpeechBubbleMorph>>drawBalloonOn:in: (in category 'drawing') -----
+ drawBalloonOn: aCanvas in: sourceRect
+ | cornerBounds rect1 rect2 |
+ cornerBounds := self class topLeftCornerForm boundingBox.
+ aCanvas translucentImage: self class topLeftCornerForm at: sourceRect topLeft;
+ 		translucentImage: self class topRightCornerForm at: sourceRect topRight - (cornerBounds width @ 0);
+ 		translucentImage: self class bottomLeftCornerForm at: sourceRect bottomLeft - (0 @ (cornerBounds height));
+ 		translucentImage: self class bottomRightCornerForm at: sourceRect bottomRight - cornerBounds extent.
+ 
+ rect1 := sourceRect topLeft + (cornerBounds width @ 1) corner: sourceRect bottomRight - (cornerBounds width @ 1).
+ rect2 := sourceRect topLeft + (1 @ cornerBounds height) corner: sourceRect bottomRight - (1 @ cornerBounds height).
+ aCanvas fillRectangle: rect1 color: Color white; fillRectangle: rect2 color: Color white.
+ aCanvas line: rect1 topLeft to: rect1 topRight width: 2 color: Color black;
+ 		line: rect1 bottomLeft to: rect1 bottomRight width: 2 color: Color black;
+ 		line: rect2 topLeft to: rect2 bottomLeft width: 2 color: Color black;
+ 		line: rect2 topRight to: rect2 bottomRight width: 2 color: Color black.
+ !

Item was added:
+ ----- Method: SpeechBubbleMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas!

Item was added:
+ ----- Method: SpeechBubbleMorph>>extent: (in category 'accessing') -----
+ extent: aPoint
+ | width height |
+ width := aPoint x max: self minimumAcceptedWidth.
+ height := aPoint y max: self minimumAcceptedHeight.
+ super extent: width @ height.
+ self refresh.
+ target notNil ifTrue: [self positionMyselfAccordingToTarget]!

Item was added:
+ ----- Method: SpeechBubbleMorph>>fillStyle: (in category 'accessing') -----
+ fillStyle: aFillStyle
+ 	super fillStyle: aFillStyle.
+ 	self refresh!

Item was added:
+ ----- Method: SpeechBubbleMorph>>form (in category 'accessing') -----
+ form
+ ^(msgMorph isKindOf: SketchMorph) ifTrue: [msgMorph form]!

Item was added:
+ ----- Method: SpeechBubbleMorph>>incrementStepTime (in category 'stepping') -----
+ incrementStepTime
+ 	stepTime := (stepTime + 1) min: self maximumStepTime!

Item was added:
+ ----- Method: SpeechBubbleMorph>>initialize (in category 'initialize-release') -----
+ initialize
+ super initialize.
+ stepTime := self minimumStepTime.
+ self positionBalloon; positionTail; positionMsgMorph.
+ self addMorph: self balloon; addMorph: self tail; addMorph: self msgMorph.
+ self extent: self msgMorphExtent + (20 @ self tailHeight + 20); color: Color white.!

Item was added:
+ ----- Method: SpeechBubbleMorph>>keyStroke:morph: (in category 'event handling') -----
+ keyStroke: anEvent morph: aMorph 
+ 	| string |
+ 	(self msgMorph isKindOf: UserText) ifFalse: [^self].
+ 
+ 	string := self msgMorph contents.
+ 
+ 	"Update text width if necessary. Make sure we keep the selection at the end of the text so that the user can keep modifying"
+ 	self msgMorph width > 300
+ 		ifTrue: [self msgMorph contents: string wrappedTo: 300.
+ 			self msgMorph editor selectFrom: string size + 1 to: string size].
+ 
+ 	"Update my extent"
+ 	self extent: self msgMorphExtent + (20 @ self tailHeight + 20).
+ !

Item was added:
+ ----- Method: SpeechBubbleMorph>>maximumStepTime (in category 'stepping') -----
+ maximumStepTime
+ 	^500!

Item was added:
+ ----- Method: SpeechBubbleMorph>>minimumAcceptedHeight (in category 'accessing') -----
+ minimumAcceptedHeight
+ ^100 max: self msgMorph fullBounds height + 20 + self tailHeight!

Item was added:
+ ----- Method: SpeechBubbleMorph>>minimumAcceptedWidth (in category 'accessing') -----
+ minimumAcceptedWidth
+ ^ 175 max: self msgMorph fullBounds width + 20!

Item was added:
+ ----- Method: SpeechBubbleMorph>>minimumStepTime (in category 'stepping') -----
+ minimumStepTime
+ 	^20!

Item was added:
+ ----- Method: SpeechBubbleMorph>>msgMorph (in category 'accessing') -----
+ msgMorph
+ ^msgMorph isNil ifTrue: [nil] ifFalse: [msgMorph topRendererOrSelf]!

Item was added:
+ ----- Method: SpeechBubbleMorph>>msgMorphExtent (in category 'accessing') -----
+ msgMorphExtent
+ ^self msgMorph fullBounds extent!

Item was added:
+ ----- Method: SpeechBubbleMorph>>position: (in category 'accessing') -----
+ position: aPoint
+ target notNil ifTrue: [^self positionMyselfAccordingToTarget ].
+ super position: aPoint.!

Item was added:
+ ----- Method: SpeechBubbleMorph>>positionBalloon (in category 'initialize-release') -----
+ positionBalloon
+ self balloon position: self position!

Item was added:
+ ----- Method: SpeechBubbleMorph>>positionMsgMorph (in category 'initialize-release') -----
+ positionMsgMorph
+ | diff |
+ diff := self msgMorph center - self msgMorph fullBounds center.
+ self msgMorph center: self center - (0 @ self tailHeight / 2) + diff.!

Item was added:
+ ----- Method: SpeechBubbleMorph>>positionMyselfAccordingToTarget (in category 'stepping') -----
+ positionMyselfAccordingToTarget
+ 	| newCenter newOwner |
+ 	"Modify mi position"
+ 	newCenter := target topRendererOrSelf center - (0 @ ((target topRendererOrSelf height + self height) / 2)).
+ 	self privatePosition: newCenter - (self topRendererOrSelf extent // 2).
+ 	"Don't forget to check if my owner is still the right one. Maybe the morph was inside a Playfield and the user grabed it and put it in the World"
+ 	(newOwner := target ownerThatIsA: PasteUpMorph) ifNil: [^self].
+ 	self owner ~= newOwner ifTrue: [newOwner addMorph: self topRendererOrSelf]!

Item was added:
+ ----- Method: SpeechBubbleMorph>>positionTail (in category 'initialize-release') -----
+ positionTail
+ self tail position: self bottomCenter - (0 @ self tailHeight + 2)!

Item was added:
+ ----- Method: SpeechBubbleMorph>>privatePosition: (in category 'private') -----
+ privatePosition: aPoint
+ "Always changes the position, regardless of the target"
+ self isFlexed ifTrue: [self topRendererOrSelf position: aPoint]
+ 				ifFalse: [super position: aPoint]
+ !

Item was added:
+ ----- Method: SpeechBubbleMorph>>refresh (in category 'refreshing') -----
+ refresh
+ self refreshBalloon; refreshTail; refreshMsgMorph!

Item was added:
+ ----- Method: SpeechBubbleMorph>>refreshBalloon (in category 'refreshing') -----
+ refreshBalloon
+ 	balloon ifNotNil: [balloon delete].
+ 	balloon := nil.
+ 	self positionBalloon.
+ 	self addMorph: balloon!

Item was added:
+ ----- Method: SpeechBubbleMorph>>refreshMsgMorph (in category 'refreshing') -----
+ refreshMsgMorph
+ 	self msgMorph owner = self ifFalse: [^self delete].
+ 	self positionMsgMorph.
+ 	self addMorph: self msgMorph!

Item was added:
+ ----- Method: SpeechBubbleMorph>>refreshTail (in category 'refreshing') -----
+ refreshTail
+ 	tail ifNotNil: [tail delete].
+ 	tail := nil.
+ 	self positionTail.
+ 	self addMorph: tail!

Item was added:
+ ----- Method: SpeechBubbleMorph>>selectedTailForm (in category 'accessing') -----
+ selectedTailForm
+ 	^type caseOf: {
+ 		[#speech] -> [self class speakingForm].
+ 		[#thought] -> [self class thinkingForm].
+ 		} otherwise: [self error: 'Wrong type']!

Item was added:
+ ----- Method: SpeechBubbleMorph>>setMorph:type: (in category 'private') -----
+ setMorph: aMorph type: aSymbol
+ 	msgMorph := aMorph.
+ 	type := aSymbol!

Item was added:
+ ----- Method: SpeechBubbleMorph>>step (in category 'stepping') -----
+ step
+ (target isNil or: [lastHash = (lastHash := target boundsSignatureHash)])
+ 		ifTrue: [self incrementStepTime]
+ 		ifFalse: [stepTime := self minimumStepTime].
+ 
+ target notNil ifTrue: [
+ target isInWorld ifFalse: [^self delete].
+ self positionMyselfAccordingToTarget].
+ 
+ "This will keep the correct extent if the graphic changed"
+ self msgMorph notNil ifTrue: [
+ (self balloon fullBounds containsRect: self msgMorph fullBounds)
+ 	ifFalse: [self extent: 1 at 1]]
+ !

Item was added:
+ ----- Method: SpeechBubbleMorph>>stepTime (in category 'stepping') -----
+ stepTime
+ ^stepTime !

Item was added:
+ ----- Method: SpeechBubbleMorph>>string (in category 'accessing') -----
+ string
+ ^(msgMorph isKindOf: UserText) ifTrue: [msgMorph contents]!

Item was added:
+ ----- Method: SpeechBubbleMorph>>tail (in category 'accessing') -----
+ tail
+ ^tail ifNil: [
+ 	| tailForm |
+ 	tailForm := self selectedTailForm deepCopy.
+ 	
+ 	"This will paint both forms correctly"
+ 	tailForm floodFill: self color at: tailForm center + (6 at -15).
+ 
+ 	"In the #thought case, we also need to paint the little bubbles"
+ 	type = #thought ifTrue: [
+ 		tailForm floodFill: self color at: tailForm center + (-7 at 7);
+ 				floodFill: self color at: tailForm center + (-22 at 20)
+ 	].
+ 
+ 	tail := SketchMorph withForm: tailForm]!

Item was added:
+ ----- Method: SpeechBubbleMorph>>tailHeight (in category 'accessing') -----
+ tailHeight
+ ^self tail height!

Item was added:
+ ----- Method: SpeechBubbleMorph>>target (in category 'accessing') -----
+ target
+ 	^target!

Item was added:
+ ----- Method: SpeechBubbleMorph>>target: (in category 'accessing') -----
+ target: aMorph
+ 	target isMorph ifTrue: [target bubble: nil].
+ 	target := aMorph.
+ 	target notNil ifTrue: [target bubble: self topRendererOrSelf. self positionMyselfAccordingToTarget ]!

Item was added:
+ ----- Method: SpeechBubbleMorph>>type (in category 'accessing') -----
+ type
+ ^type!

Item was added:
+ ----- Method: StackMorph class>>formerDescriptionForPartsBin (in category '*Etoys-Squeakland-parts bin') -----
+ formerDescriptionForPartsBin
+ 	^ self partName:	'Stack' translatedNoop
+ 		categories:		#()
+ 		documentation:	'A database of any sort -- slide show, rolodex, and any point in between' translatedNoop!

Item was changed:
  ----- Method: StackMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
  registerInFlapsRegistry
  	"Register the receiver in the system's flaps registry"
  	self environment
  		at: #Flaps
+ 		ifPresent: [:cl | cl registerQuad: {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}	
- 		ifPresent: [:cl | cl registerQuad: #(StackMorph	authoringPrototype	'Stack'		'A multi-card data base'	)
  						forFlapNamed: 'Scripting'.
+ 						cl registerQuad: {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}
- 						cl registerQuad: #(StackMorph	authoringPrototype	'Stack'		'A multi-card data base'	)
  						forFlapNamed: 'Stack Tools'.
+ 						cl registerQuad: {#StackMorph. #stackHelpWindow. 'Stack Help' translatedNoop. 'Some hints about how to use Stacks' translatedNoop}
- 						cl registerQuad: #(StackMorph	stackHelpWindow	'Stack Help'	'Some hints about how to use Stacks')
  						forFlapNamed: 'Stack Tools'.
+ 						cl registerQuad: {#StackMorph. #previousCardButton. 'Previous Card' translatedNoop. 'A button that takes the user to the previous card in the stack' translatedNoop}
- 						cl registerQuad: #(StackMorph	previousCardButton	'Previous Card'	'A button that takes the user to the previous card in the stack')
  						forFlapNamed: 'Stack Tools'.
+ 						cl registerQuad: {#StackMorph. #nextCardButton. 'Next Card' translatedNoop. 'A button that takes the user to the next card in the stack' translatedNoop}
- 						cl registerQuad: #(StackMorph	nextCardButton	'Next Card'		'A button that takes the user to the next card in the stack')
  						forFlapNamed: 'Stack Tools']!

Item was changed:
  ----- Method: StackMorph class>>stackHelpWindow (in category 'parts bin') -----
  stackHelpWindow
  	^ (Workspace new contents: 'A "stack" is a place where you can create, store, view and retrieve data "fields" from a set of "cards".  Data that you want to occur on every card (such as a name and an address in an Address Stack) are represented by objects such as "Simple Text", "Fancy Text", and "Scrolling Text" that you obtain from the Stack Tools flap.
  
  When you look at a card in a Stack, you may be seeing three different kinds of material.  Press the § button in the stack''s controls to see the current designations, and use the "explain designations" to get a reminder of what the three different colors mean.
  ·  Things that are designated to be seen on every card, and have the same contents whichever card is being shown. (green)
  ·  Things that are designated to be seen on every card, with each card having its own value for them. (orange)
  ·  Things that are designated to occur only on the particular card at hand. (red)
  
  Use the "stack/cards" menu (in an object''s halo menu) to change the designation of any object.  For example, if you have an object that is private to just one card, and you want to make it visible on all cards, use "place onto background".  If you further want it to hold a separate value for each separate card, use "start holding separate data for each instance".
  
  The normal sequence to define a Stack''s structure is to obtain a blank Stack, then create your fields by grabbing what you want from the Stack Tools flap and dropping it where you want it in the stack.  For easiest use, give a name to each field (by editing the name in its halo) *before* you put it onto the background..  Those fields that you want to represent the basic data of the stack need to be given names, placed on the background, and then told to hold separate data.
  
  When you hit the + button in a stack''s controls, a new card is created with default values in all the fields.  You can arrange for a particular default value to be used in a field -- do this either for one field at a time with "be default value on new card", or you can request that the all the values seen on a particular card serve as default by choosing "be defaults for new cards" from the stack''s · menu.
  
  It is also possible to have multiple "backgrounds" in the same stack -- each different background defines a different data structure, and cards from multiple backgrounds can be freely mixed in the same stack.
  
+ Besides text fields, it is also possible to have picture-valued fields -- and potentially fields with data values of any other type as well.' translated)
- Besides text fields, it is also possible to have picture-valued fields -- and potentially fields with data values of any other type as well.')
  
+ 	embeddedInMorphicWindowLabeled: 'Stack Help'
- 	openLabel: 'Stack Help'
  
  	"StackMorph stackHelpWindow"!

Item was changed:
  ----- Method: StackMorph>>fullControlSpecs (in category 'page controls') -----
  fullControlSpecs
  	"Answer specifications for the long form of iconic stack/book controls"
  
+ 	^ {
+ 		#spacer.
+ 		#variableSpacer.
+ 		{'-'.			#deleteCard.			'Delete this card' translated}.
+ 		#spacer.
+ 		{ '¬´'	.		#goToFirstCardOfStack.	'First card' translated}.
+ 		#spacer.
+ 		{ '<'. 		#goToPreviousCardInStack.		'Previous card' translated}.
+ 		#spacer.
+ 		{'¬'.			#invokeBookMenu. 	'Click here to get a menu of options for this stack.' translated}.
+ 		"#spacer.	{'¬Ž'.			#reshapeBackground.  'Reshape' translated}.	"
- 	^ #(
- 		spacer
- 		variableSpacer
- 		('-'			deleteCard					'Delete this card')
- 		spacer
- 		( '«'		goToFirstCardOfStack			'First card')
- 		spacer
- 		( '<' 		goToPreviousCardInStack		'Previous card')
- 		spacer
- 		('·'			invokeBookMenu 			'Click here to get a menu of options for this stack.')
- 		"spacer	('¶'			reshapeBackground  		'Reshape')	"
  
+ 		#spacer.
+ 		{'§'.			#showDesignationsOfObjects. 	'Show designations' translated}.
+ 		#spacer.
+ 		{'>'	.		#goToNextCardInStack.	'Next card' translated}.
+ 		#spacer.
+ 		{ '»'.		#goToLastCardOfStack.	'Final card' translated}.
+ 		#spacer.
+ 		{'+'.		#insertCard.			'Add a new card after this one' translated}.
+ 		#variableSpacer.
+ 		{'¬'.			#fewerPageControls.			'Fewer controls
- 		spacer
- 		('§'			showDesignationsOfObjects 	'Show designations')
- 		spacer
- 		('>'			goToNextCardInStack			'Next card')
- 		spacer
- 		( '»'		goToLastCardOfStack			'Final card')
- 		spacer
- 		('+'			insertCard					'Add a new card after this one')
- 		variableSpacer
- 		('³'			fewerPageControls			'Fewer controls
  (if shift key pressed,
+ deletes controls)' translated}
+ }!
- deletes controls)')
- )!

Item was changed:
  ----- Method: StackMorph>>goToCard (in category 'card access') -----
  goToCard
  	"prompt the user for an ordinal number, and use that as a basis for choosing a new card to install in the receiver"
  
  	| reply index |
+ 	reply _ FillInTheBlank request: 'Which card number? ' translated initialAnswer: '1'.
- 	reply := UIManager default request: 'Which card number? ' translated initialAnswer: '1'.
  	reply isEmptyOrNil ifTrue: [^ self].
+ 	((index _ reply asNumber) > 0 and: [index <= self privateCards size])
+ 		ifFalse: [^ self inform: 'no such card' translated].
- 	((index := reply asNumber) > 0 and: [index <= self privateCards size])
- 		ifFalse: [^ self inform: 'no such card'].
  	self goToCard: (self privateCards at: index)!

Item was changed:
  ----- Method: StackMorph>>initializeWith: (in category 'initialization') -----
  initializeWith: aCardMorph
  	"Install the card inside a new stack.  Make no border or controls, so I the card's look is unchanged.  Card already has a CardPlayer."
  	
  	| wld |
+ 	wld _ aCardMorph world.
- 	wld := aCardMorph world.
  	self initialize.
  	self pageSize: aCardMorph extent.
  	self borderWidth: 0; layoutInset: 0; color: Color transparent.
+ 	pages _ Array with: aCardMorph.
+ 	self currentPage: aCardMorph.
- 	pages := Array with: aCardMorph.
- 	currentPage := aCardMorph.
  	self privateCards: (OrderedCollection with: currentPage currentDataInstance).
  	currentPage beAStackBackground.
  	self position: aCardMorph position.
  	submorphs last delete.
  	self addMorph: currentPage.	
  	self showPageControls: self fullControlSpecs.
  	wld addMorph: self.
  !

Item was changed:
  ----- Method: StackMorph>>insertAsBackground:resize: (in category 'background') -----
  insertAsBackground: newPage resize: doResize
  	"Make a new background for the stack.  Obtain a name for it from the user.  It starts out life empty"
  
  	| aName |
+ 	aName _ FillInTheBlank request: 'What should we call this new background?' translated initialAnswer: 'alternateBackground' translated.
- 	aName := UIManager default request: 'What should we call this new background?' translated initialAnswer: 'alternateBackground' translated.
  	aName isEmptyOrNil ifTrue: [^ self].
  	newPage beSticky.
  	doResize ifTrue: [newPage extent: currentPage extent].
  	newPage beAStackBackground.
  	newPage setNameTo: aName.
  	newPage vResizeToFit: false.
  	pages isEmpty
  		ifTrue: [pages add: newPage]
  		ifFalse: [pages add: newPage after: currentPage].
  	self privateCards add: newPage currentDataInstance after: currentPage currentDataInstance.
  	self nextPage.
  !

Item was changed:
  ----- Method: StackMorph>>offerBookishMenu (in category 'menu') -----
  offerBookishMenu
  	"Offer a menu with book-related items in it"
  
  	| aMenu |
+ 	aMenu _ MenuMorph new defaultTarget: self.
- 	aMenu := MenuMorph new defaultTarget: self.
  	aMenu addTitle: 'Stack / Book' translated.
+ 	aMenu addStayUpItem.
- 	Preferences noviceMode
- 		ifFalse: [aMenu addStayUpItem].
  	aMenu addList:
  		#(('sort pages' sortPages)
  		('uncache page sorter' uncachePageSorter)).
  	(self hasProperty: #dontWrapAtEnd)
  		ifTrue: [aMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true]
  		ifFalse: [aMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false].
  	aMenu addList:
  		#(('make bookmark'	 bookmarkForThisPage)
  		('make thumbnail' thumbnailForThisPage)).
  
  	aMenu addLine.
  	aMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:.
  	aMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:.
  	aMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:.
  	aMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:.
  
  	aMenu addLine.
  	(self primaryHand pasteBuffer class isKindOf: PasteUpMorph class) ifTrue:
  		[aMenu add: 'paste book page'   translated action: #pasteBookPage].
  
  	aMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype.
  	newPagePrototype ifNotNil: [
  		aMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype].
  
  	aMenu add: (self dragNDropEnabled ifTrue: ['close' translated ] ifFalse: ['open' translated]) , ' dragNdrop' translated
  			action: #toggleDragNDrop.
  	aMenu addLine.
  	aMenu add: 'make all pages this size' translated action: #makeUniformPageSize.
  	aMenu addUpdating: #keepingUniformPageSizeString target: self action: #toggleMaintainUniformPageSize.
  	aMenu addLine.
  	aMenu add: 'send all pages to server' translated action: #savePagesOnURL.
  	aMenu add: 'send this page to server' translated action: #saveOneOnURL.
  	aMenu add: 'reload all from server' translated action: #reload.
  	aMenu add: 'copy page url to clipboard' translated action: #copyUrl.
  	aMenu add: 'keep in one file' translated action: #keepTogether.
  
  	aMenu addLine.
  	aMenu add: 'load PPT images from slide #1' translated action: #loadImagesIntoBook.
  	aMenu add: 'background color for all pages...' translated action: #setPageColor.
  
  	aMenu popUpEvent: self world activeHand lastEvent in: self world
+ 
+ 
  !

Item was changed:
  ----- Method: StackMorph>>shortControlSpecs (in category 'page controls') -----
  shortControlSpecs
  	"Answer specficiations for the shorter form of stack controls"
  
+ 	^ {
+ 		#spacer.
+ 		#variableSpacer.
+ 		{ '<'.	#goToPreviousCardInStack.		'Previous card' translated}.
+ 		#spacer.
+ 		{'¬'.		#invokeBookMenu. 			'Click here to get a menu for this stack.' translated}.
+ 		#spacer.
+ 		{'>'.	#goToNextCardInStack.		'Next card' translated}.
+ 		#variableSpacer.
+ 		{'¬'.		#showMoreControls.			'More controls
- 	^ #(
- 		spacer
- 		variableSpacer
- 		( '<'		goToPreviousCardInStack		'Previous card')
- 		spacer
- 		('·'		invokeBookMenu 			'Click here to get a menu for this stack.')
- 		spacer
- 		('>'		goToNextCardInStack			'Next card')
- 		variableSpacer
- 		('³'	showMoreControls				'More controls
  (if shift key pressed,
+ deletes controls)' translated}
+ }!
- deletes controls)'))!

Item was added:
+ AbstractFont subclass: #StandInFont
+ 	instanceVariableNames: 'familyName pointSize emphasis'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Graphics-Text'!

Item was added:
+ ----- Method: StandInFont>>ascent (in category 'as yet unclassified') -----
+ ascent
+ 
+ 	| threeQ |
+ 	threeQ := pointSize * 3 // 4.
+ 	^ threeQ.
+ !

Item was added:
+ ----- Method: StandInFont>>descent (in category 'as yet unclassified') -----
+ descent
+ 
+ 	| threeQ |
+ 	threeQ := pointSize * 3 // 4.
+ 	^ pointSize - threeQ.
+ !

Item was added:
+ ----- Method: StandInFont>>emphasis (in category 'as yet unclassified') -----
+ emphasis
+ 
+ 	^ emphasis!

Item was added:
+ ----- Method: StandInFont>>emphasized: (in category 'as yet unclassified') -----
+ emphasized: code
+ 
+ 	^ TextStyle defaultFont emphasized: code.
+ !

Item was added:
+ ----- Method: StandInFont>>familyName (in category 'as yet unclassified') -----
+ familyName
+ 
+ 	^ familyName!

Item was added:
+ ----- Method: StandInFont>>familyName:pointSize:emphasized: (in category 'as yet unclassified') -----
+ familyName: aString pointSize: aNumber emphasized: emph
+ 
+ 	familyName := aString.
+ 	pointSize := aNumber.
+ 	emphasis := emph.
+ !

Item was added:
+ ----- Method: StandInFont>>height (in category 'as yet unclassified') -----
+ height
+ 
+ 	^ pointSize.
+ !

Item was added:
+ ----- Method: StandInFont>>pointSize (in category 'as yet unclassified') -----
+ pointSize
+ 
+ 	^ pointSize!

Item was added:
+ ----- Method: StandardFileStream class>>fileDoesNotExistUserHandling: (in category '*Etoys-Squeakland-error handling') -----
+ fileDoesNotExistUserHandling: fullFileName
+ 
+ 	| selection newName |
+ 	selection _ (PopUpMenu labels:
+ 'create a new file
+ choose another name
+ cancel' translated)
+ 			startUpWithCaption: ('{1}
+ does not exist.' translated format: {FileDirectory localNameFor: fullFileName}) .
+ 
+ 	selection = 1 ifTrue:
+ 		[^ self new open: fullFileName forWrite: true].
+ 	selection = 2 ifTrue:
+ 		[ newName _ FillInTheBlank request: 'Enter a new file name' translated
+ 						initialAnswer:  fullFileName.
+ 		^ self oldFileNamed:
+ 			(self fullName: newName)].
+ 	^ self error: 'Could not open a file'!

Item was added:
+ ----- Method: StandardFileStream class>>fileExistsUserHandling: (in category '*Etoys-Squeakland-error handling') -----
+ fileExistsUserHandling: fullFileName
+ 	| dir localName choice newName newFullFileName |
+ 	dir _ FileDirectory forFileName: fullFileName.
+ 	localName _ FileDirectory localNameFor: fullFileName.
+ 	choice _ (PopUpMenu
+ 		labels:
+ 'overwrite that file\choose another name\cancel' translated withCRs)
+ 		startUpWithCaption: ('{1}
+ already exists.' translated format: {localName}).
+ 
+ 	choice = 1 ifTrue: [
+ 		dir deleteFileNamed: localName
+ 			ifAbsent: [self error: 'Could not delete the old version of that file' translated].
+ 		^ self new open: fullFileName forWrite: true].
+ 
+ 	choice = 2 ifTrue: [
+ 		newName _ FillInTheBlank request: 'Enter a new file name' translated initialAnswer: fullFileName.
+ 		newFullFileName _ self fullName: newName.
+ 		^ self newFileNamed: newFullFileName].
+ 
+ 	self error: 'Please close this to abort file opening' translated!

Item was added:
+ ----- Method: StandardFileStream class>>readOnlyFileDoesNotExistUserHandling: (in category '*Etoys-Squeakland-error handling') -----
+ readOnlyFileDoesNotExistUserHandling: fullFileName
+ 
+ 	| dir files choices selection newName fileName |
+ 	dir _ FileDirectory forFileName: fullFileName.
+ 	files _ dir fileNames.
+ 	fileName _ FileDirectory localNameFor: fullFileName.
+ 	choices _ fileName correctAgainst: files.
+ 	choices add: 'Choose another name' translated.
+ 	choices add: 'Cancel' translated.
+ 	selection _ (PopUpMenu labelArray: choices lines: (Array with: 5) )
+ 		startUpWithCaption: ( '{1}
+ does not exist.' translated format: {FileDirectory localNameFor: fullFileName}).
+ 	selection = choices size ifTrue:["cancel" ^ nil "should we raise another exception here?"].
+ 	selection < (choices size - 1) ifTrue: [
+ 		newName _ (dir pathName , FileDirectory slash , (choices at: selection))].
+ 	selection = (choices size - 1) ifTrue: [
+ 		newName _ FillInTheBlank 
+ 							request: 'Enter a new file name' translated 
+ 							initialAnswer: fileName].
+ 	newName = '' ifFalse: [^ self readOnlyFileNamed: (self fullName: newName)].
+ 	^ self error: 'Could not open a file'!

Item was changed:
  ----- Method: StandardScriptingSystem class>>removePlayersIn: (in category '*Etoys') -----
  removePlayersIn: project
  	"Remove existing player references for project"
  
+ 	project world presenter reallyAllExtantPlayers do: [:pl |
+ 		References removeKey: (project world uniqueNameForReferenceFor: pl)  ifAbsent: []
+ 	].
- 	References keys do: 
- 		[:key | (References at: key) costume pasteUpMorph == project world
- 			ifTrue: [References removeKey: key]].
  !

Item was added:
+ ----- Method: StandardScriptingSystem>>absTileIconForm (in category '*Etoys-Squeakland-utilities') -----
+ absTileIconForm
+ 	"Answer the form to use in the gold box for the abs tile item."
+ 
+ 	^ self formAtKey: #absTileIconForm!

Item was changed:
  ----- Method: StandardScriptingSystem>>acceptableSlotNameFrom:forSlotCurrentlyNamed:asSlotNameIn:world: (in category '*Etoys-universal slots & scripts') -----
  acceptableSlotNameFrom: originalString forSlotCurrentlyNamed: currentName asSlotNameIn: aPlayer world: aWorld
  	"Produce an acceptable slot name, derived from the current name, for aPlayer.  This method will always return a valid slot name that will be suitable for use in the given situation, though you might not like its beauty sometimes."
  
  	| aString stemAndSuffix proscribed stem suffix putative |
+ 	aString _ originalString asIdentifier: false.  "get an identifier not lowercase"
+ 	stemAndSuffix _ aString stemAndNumericSuffix.
+ 	proscribed _ #(self super thisContext costume costumes dependents #true #false size), aPlayer class allInstVarNames, Vocabulary eToyVocabulary systemSlotNames.
- 	aString := originalString asIdentifier: false.  "get an identifier not lowercase"
- 	stemAndSuffix := aString stemAndNumericSuffix.
- 	proscribed := #(self super thisContext costume costumes dependents #true #false size), aPlayer class allInstVarNames.
  
+ 	stem _ stemAndSuffix first.
+ 	suffix _ stemAndSuffix last.
+ 	putative _ aString asSymbol.
- 	stem := stemAndSuffix first.
- 	suffix := stemAndSuffix last.
- 	putative := aString asSymbol.
  	
  	[(putative ~~ currentName) and: [(proscribed includes: putative)
  		or:	[(aPlayer respondsTo: putative)
  		or:	[Smalltalk includesKey: putative]]]]
  	whileTrue:
+ 		[suffix _ suffix + 1.
+ 		putative _ (stem, suffix printString) asSymbol].
- 		[suffix := suffix + 1.
- 		putative := (stem, suffix printString) asSymbol].
  	^ putative!

Item was changed:
  ----- Method: StandardScriptingSystem>>arithmeticalOperatorsAndHelpStrings (in category '*Etoys-utilities') -----
  arithmeticalOperatorsAndHelpStrings
  	"Answer an array consisting of lists of the standard arithmetical operator tiles and of the corresponding balloon help for them"
  
  	^ #((+ - * / // \\ max: min:)
+ 	 	('add' 'subtract' 'multiply' 'divide' 'divide & truncate' 'remainder when divided by' 'larger value' 'smaller value' )) translatedNoop!
- 	 	('add' 'subtract' 'multiply' 'divide' 'divide & truncate' 'remainder when divided by' 'larger value' 'smaller value' ))!

Item was added:
+ ----- Method: StandardScriptingSystem>>assureFlapOfLabel:withContents: (in category '*Etoys-Squeakland-help in a flap') -----
+ assureFlapOfLabel: aTitle withContents: aString
+ 	"Answer an info flap with the given title and contents.  If one exists in the project, use that, else create one & insert it in the world.  Answer the flap tab."
+ 
+ 	| allFlapTabs aTab |
+ 	allFlapTabs :=  ActiveWorld localFlapTabs, ActiveWorld extantGlobalFlapTabs.
+ 	aTab := allFlapTabs detect:
+ 		[:ft | ft flapID = aTitle] ifNone: [nil].
+ 	aTab ifNotNil: [^ aTab].  "already present"
+ 
+ 	aTab := self openInfoFlapWithLabel: aTitle helpContents: aString edge: #left.
+ 	aTab bottom: ActiveWorld bottom.
+ 	self cleanUpFlapTabsOnLeft.
+ 	aTab hideFlap.
+ 	aTab referent show.
+ 	aTab show.
+ 	^ aTab
+ 
+ "
+ ScriptingSystem assureFlapOfLabel: 'Egg Sample' withContents: EventRollMorph basicNew helpString
+ "!

Item was added:
+ ----- Method: StandardScriptingSystem>>baseColor (in category '*Etoys-Squeakland-tile colors') -----
+ baseColor
+ 	^ Preferences menuTitleColor!

Item was added:
+ ----- Method: StandardScriptingSystem>>benchmark:label:on: (in category '*Etoys-Squeakland-benchmarks') -----
+ benchmark: selector label: aString on: aStream 
+ 	"ScriptingSystem benchmark: #benchmarkPainter label: 'painter' on:
+ 	Transcript. Transcript flush."
+ 	| result trial |
+ 	trial := 5.
+ 	result := 0.
+ 	trial
+ 		timesRepeat: [result := result
+ 						+ (self perform: selector)].
+ 	aStream nextPutAll: aString;
+ 		 nextPut: $=;
+ 		 print: (result / 5) asFloat;
+ 		 space!

Item was added:
+ ----- Method: StandardScriptingSystem>>benchmarkCategory (in category '*Etoys-Squeakland-benchmarks') -----
+ benchmarkCategory
+ 	"ScriptingSystem benchmarkCategory"
+ 	| m v result |
+ 	m := Morph new openInWorld.
+ 	m openViewerForArgument.
+ 	World doOneCycle.
+ 	v := m player allOpenViewers first submorphs last.
+ 	result := [v chosenCategorySymbol: #geometry.
+ 			World doOneCycle] timeToRun.
+ 	m delete.
+ 	World doOneCycle.
+ 	^ result!

Item was added:
+ ----- Method: StandardScriptingSystem>>benchmarkPainter (in category '*Etoys-Squeakland-benchmarks') -----
+ benchmarkPainter
+ 	"ScriptingSystem benchmarkPainter"
+ 	| result |
+ 	result := [World makeNewDrawing: nil at: 400 @ 300.
+ 			World doOneCycle] timeToRun.
+ 	(World findA: SketchEditorMorph) cancelOutOfPainting.
+ 	World doOneCycle.
+ 	^ result!

Item was added:
+ ----- Method: StandardScriptingSystem>>benchmarkScriptor (in category '*Etoys-Squeakland-benchmarks') -----
+ benchmarkScriptor
+ 	"ScriptingSystem benchmarkScriptor"
+ 	"(Picking up third one)"
+ 	| result m |
+ 	m := Morph new openInWorld.
+ 	m openViewerForArgument.
+ 	m player assureUniClass.
+ 	m player newScriptorAround: nil.
+ 	m player newScriptorAround: nil.
+ 	result := [(m player newScriptorAround: nil) openInWorld.
+ 			World doOneCycle] timeToRun.
+ 	m delete.
+ 	World doOneCycle.
+ 	^ result!

Item was added:
+ ----- Method: StandardScriptingSystem>>benchmarkViewer (in category '*Etoys-Squeakland-benchmarks') -----
+ benchmarkViewer
+ 	"ScriptingSystem benchmarkViewer"
+ 	| result m |
+ 	m := Morph new openInWorld.
+ 	result := [m openViewerForArgument.
+ 			World doOneCycle] timeToRun.
+ 	m delete.
+ 	World doOneCycle.
+ 	^ result!

Item was added:
+ ----- Method: StandardScriptingSystem>>biggerHandlesPreferenceChanged (in category '*Etoys-Squeakland-utilities') -----
+ biggerHandlesPreferenceChanged
+ 	"The biggerHandles preference was changed..."
+ 
+ 	| prefix aName form |
+ 	prefix := Preferences biggerHandles ifTrue: ['Large'] ifFalse: ['Small'].
+ 	#('Collapse' 'Debug' 'Dismiss' 'Drag' 'Dup' 'FontEmph' 'FontSize' 'FontStyle' 'Grab' 'Help' 'Menu' 'Paint' 'Pooh' 'Recolor' 'Rot' 'Scale' 'Tile' 'View' 'Script') do:
+ 		[:stem |
+ 			aName := 'Halo-', stem.
+ 			form := ScriptingSystem formAtKey: (prefix, aName).
+ 			form ifNil: [ScriptingSystem formDictionary removeKey: aName asSymbol ifAbsent: []]
+ 				ifNotNil: [ScriptingSystem saveForm: form atKey: aName]].!

Item was added:
+ ----- Method: StandardScriptingSystem>>borderColor (in category '*Etoys-Squeakland-tile colors') -----
+ borderColor
+ 	^ Preferences menuBorderColor!

Item was added:
+ ----- Method: StandardScriptingSystem>>buildPanelTitled: (in category '*Etoys-Squeakland-utilities') -----
+ buildPanelTitled: aTitle 
+ 	"(ScriptingSystem buildPanelTitled: 'title') openInHand"
+ 	| outer title aDismissButton |
+ 	outer := OLPCHelpDisplayer newColumn.
+ 	outer color: ScriptingSystem baseColor.
+ 	outer borderWidth: 1.
+ 	outer borderColor: ScriptingSystem borderColor.
+ 	outer hResizing: #shrinkWrap.
+ 	outer vResizing: #shrinkWrap.
+ 	outer useRoundedCornersInEtoys.
+ 	outer layoutInset: 3 @ 3.
+ 	outer cellInset: 0 @ 0.
+ 	title := AlignmentMorph newRow.
+ 	title beTransparent.
+ 	aDismissButton := outer tanOButton.
+ 	title addMorphFront: aDismissButton.
+ 	title addTransparentSpacerOfSize: 6 @ 0.
+ 	title
+ 		addMorphBack: (StringMorph contents: aTitle font: ScriptingSystem fontForTiles).
+ 	outer addMorphBack: title.
+ 	^ outer!

Item was added:
+ ----- Method: StandardScriptingSystem>>buttonExtent (in category '*Etoys-Squeakland-buttons') -----
+ buttonExtent
+ 	"ScriptingSystem buttonExtent"
+ 	^ (ScriptingSystem formAtKey: #TryIt) extent!

Item was added:
+ ----- Method: StandardScriptingSystem>>buttonSpacer (in category '*Etoys-Squeakland-buttons') -----
+ buttonSpacer
+ 	"ScriptingSystem buttonSpacer openInHand"
+ 	| m |
+ 	m := Morph new.
+ 	m color: Color transparent.
+ 	m extent: self buttonExtent.
+ 	^ m!

Item was added:
+ ----- Method: StandardScriptingSystem>>cleanUpFlapTabsOnLeft (in category '*Etoys-Squeakland-help in a flap') -----
+ cleanUpFlapTabsOnLeft
+ 	"Make sure the flap tabs on the left of the screen line up nicely, making best use of realestate."
+ 
+ 	| tabsOnLeft current |
+ 	tabsOnLeft :=  ((ActiveWorld localFlapTabs, ActiveWorld extantGlobalFlapTabs) select: [:f | f edgeToAdhereTo = #left])
+ 		asSortedCollection: [:a :b | a top <= b top].
+ 	current := SugarNavigatorBar showSugarNavigator
+ 		ifTrue:
+ 			[75]
+ 		ifFalse:
+ 			[0].
+ 	tabsOnLeft do:
+ 		[:aTab |
+ 			aTab top: (current min: (ActiveWorld height - aTab height)).
+ 			current := aTab bottom + 2].
+ "
+ ScriptingSystem cleanUpFlapTabsOnLeft
+ "!

Item was added:
+ ----- Method: StandardScriptingSystem>>commandFeedback (in category '*Etoys-Squeakland-font & color choices') -----
+ commandFeedback
+ 
+             ^Color r: 1.0 g: 0.548 b: 0.452!

Item was changed:
  ----- Method: StandardScriptingSystem>>customEventNamesAndHelpStringsFor: (in category '*Etoys-customevents-custom events') -----
  customEventNamesAndHelpStringsFor: aPlayer
+ 	| retval help helpStrings morph |
- 	| retval morph |
  	morph := aPlayer costume renderedMorph.
  	retval := SortedCollection sortBlock: [ :a :b | a first < b first ].
  	self customEventsRegistry
  		keysAndValuesDo: [ :k :v |
- 			| helpStrings |
  			helpStrings := Array streamContents: [ :hsStream |
  				v keysAndValuesDo: [ :registrant :array |
  					(morph isKindOf: array second) ifTrue: [
- 						| help |
  						help := String streamContents: [ :stream |
  										v size > 1
  											ifTrue: [ stream nextPut: $(;
+ 													nextPutAll: array second name translated;
- 													nextPutAll: array second name;
  													nextPut: $);
  													space ].
+ 										stream nextPutAll: array first translated].
+ 						hsStream nextPut: help]]].
- 										stream nextPutAll: array first ].
- 						hsStream nextPut: help ]]].
  			helpStrings isEmpty ifFalse: [retval add: { k. helpStrings } ]].
  	^ retval!

Item was added:
+ ----- Method: StandardScriptingSystem>>fontForAttachedWatchers (in category '*Etoys-Squeakland-Etoys-font & color choices') -----
+ fontForAttachedWatchers
+ 	"Answer the font to use in following watchers"
+ 
+ 	^ StrikeFont familyName: 'BitstreamVeraSerif' size: 16!

Item was added:
+ ----- Method: StandardScriptingSystem>>fontForEToyButtons (in category '*Etoys-Squeakland-font & color choices') -----
+ fontForEToyButtons
+ 	"Answer the font to be used for the status buttons affiliated with a ScriptInstantiation in a Viewer or Scriptor, and with other buttons that are part of the basic etoy UI."
+ 
+ "	^ StrikeFont familyName: 'KomikaText' size: 28"
+ 	^ Preferences standardEToysButtonFont!

Item was added:
+ ----- Method: StandardScriptingSystem>>fontForViewerCategoryPopups (in category '*Etoys-Squeakland-olpc') -----
+ fontForViewerCategoryPopups
+ 	"Answer the font to be used for the category-name at the top of each category-viewer pane."
+ 
+ 	^ Preferences standardEToysButtonFont!

Item was added:
+ ----- Method: StandardScriptingSystem>>formPressedAtKey: (in category '*Etoys-Squeakland-form dictionary') -----
+ formPressedAtKey: aSymbol 
+ 	"Answer the form for pressed button. It is automatically generated if
+ 	unavailable."
+ 	"(ScriptingSystem formPressedAtKey: #TryIt) asMorph openInHand"
+ 	| pressedName pressedImage |
+ 	pressedName := (aSymbol , 'Pressed') asSymbol.
+ 	((FormDictionary includesKey: aSymbol)
+ 			and: [(FormDictionary includesKey: pressedName) not])
+ 		ifTrue: [pressedImage := ((self formAtKey: aSymbol)
+ 						blendColor: (Color black alpha: 0.3)) colorReduced.
+ 			self saveForm: pressedImage atKey: pressedName].
+ 	^ self formAtKey: pressedName!

Item was added:
+ ----- Method: StandardScriptingSystem>>getterFeedback (in category '*Etoys-Squeakland-font & color choices') -----
+ getterFeedback
+ 	
+ 	^Color r: 1.0 g: 0.355 b: 0.839!

Item was changed:
  ----- Method: StandardScriptingSystem>>goUp:with: (in category '*Etoys-script-control') -----
  goUp: evt with: aGoButton
+ 	Cursor wait showWhile: [
+ 		aGoButton presenter startRunningScriptsFrom: aGoButton
+ 	]!
- 	aGoButton presenter startRunningScriptsFrom: aGoButton!

Item was changed:
  ----- Method: StandardScriptingSystem>>helpStringOrNilForOperator: (in category '*Etoys-utilities') -----
  helpStringOrNilForOperator: anOperator
  	"Answer the help string associated with the given operator, nil if none found."
  
  	| anIndex opsAndHelp |
+ 	(anIndex _ (opsAndHelp _ self arithmeticalOperatorsAndHelpStrings) first indexOf: anOperator) > 0
- 	(anIndex := (opsAndHelp := self arithmeticalOperatorsAndHelpStrings) first indexOf: anOperator) > 0
  		ifTrue:	[^ (opsAndHelp second at: anIndex) translated].
  
+ 	(anIndex _ (opsAndHelp _ self numericComparitorsAndHelpStrings) first indexOf: anOperator) > 0
- 	(anIndex := (opsAndHelp := self numericComparitorsAndHelpStrings) first indexOf: anOperator) > 0
  		ifTrue:	[^ (opsAndHelp second at: anIndex) translated].
  
+ 	(anIndex _ (opsAndHelp _ self numericFunctionsAndHelpStrings) first indexOf: anOperator) > 0
+ 		ifTrue:	[^ (opsAndHelp second at: anIndex) translated].
- 	anOperator = #, ifTrue:
- 		[^ 'Concatenate two Strings' translated].
  
  	^ nil!

Item was added:
+ ----- Method: StandardScriptingSystem>>initializeLargeHaloIcons (in category '*Etoys-Squeakland-utilities') -----
+ initializeLargeHaloIcons
+ 	"Store the bitmaps created by update 1179LargeHalo separately in the form dictionary so they can be restored dynamicaly if smaller halos are at some point installed."
+ 
+ 	#(
+ 
+ ('R0lGODlhHgAeAJEAAOfn/wAAAP///wAAACH5BAUUAAIALAAAAAAeAB4AAAJklI8Cy5sPVZst
+ QoqZPbnr6IXAhQWmOCaZeYZqxwYiF8azVLMunrcZD/BNbKiFjkIsJhlLVLPpjEmFxeAUqrwe
+ q0wttcKVYgxc6/ZTNlNp4fOrLXO805952kJPbbgbe6cPMrZRAAA7'    'Debug')
+ 
+ ('R0lGODlhHgAeAKIAAP////7+//Pz/4CA/wAA/////wAAAAAAACH5BAUUAAUALAAAAAAeAB4A
+ AAOTWLpc9PC1SV28sVLMoV7cAIxAp3Ek2REbRg5r1rhjfM20jYF6L1kYQWBILAoINVmnyCQi
+ k5LVcBl4qHRTTvYJu0AJ28tWVPKWH+FI+Gs9g6taeJvWfVMjbAIZkubLY1d9aH83eDVNTSZA
+ c0KIQ0ccCj4+PD55P5U2Vzc4MWRuMp1mKYotowB1nB+TLB8MlK6mqhUJADs=' 'Rot')
+ 
+ ('R0lGODlhHgAeAJEAAP+cMQAAAf///wAAACH5BAUUAAIALAAAAAAeAB4AAAJclI8Cy5sPVZst
+ QoqZPbnr6IXAJYZPaSKoyK2sxATyTNd0BS/2blcUD5SFZiWixzgUHpXJQLPIzCCXTmqwZ73e
+ fA3tDud6hVO5Ma5l/qjS6nXa8t6UyfJ5pk6iyAsAOw==' 'Tile')
+ 
+ ('R0lGODlhHgAeAKIAAAAAAAD//wB/fwB/gP///wAAAAAAAAAAACH5BAUUAAQALAAAAAAeAB4A
+ AAOHSLpM8fC1SV28sVLMoV5d6FViGWxmOaUqUwqw0FoYYN+43Sl17uMYHuRnGwyIgEwEuSRy
+ mBfo8Ca7DTBHnQD4wMkCVuztsR2DqV1zUxcos8+2LzfNdifXALk1W5/jkVInf4A5GTRThGoj
+ HYk7QiExXyENLCIrlY6UmBcamyMfmB+aJqIkHKIJADs=' 'View')
+ 
+ ('R0lGODlhHgAeAJEAAAAACP///3Z2ef///yH5BAUUAAMALAAAAAAeAB4AAAKAnI8Dy5sPVZst
+ QhpyoPZQoGmf9YXh+JTmySXYarbepAmrncnvBuCZsBBNDLTcpyFkEBnJI9PoQEKdUl7RSr1q
+ s8emF8YKTkFQcLj55I2fYqx2LSa7MXFVkNOd11v5Psr/cjRTBFiBEGg35HJlJnNY1Wh4wYXS
+ QanU8ciVGSHYUQAAOw==' 'Grab')
+ 
+ ('R0lGODlhHgAeAJEAAJkzAP///8zMzAAAACH5BAUUAAIALAAAAAAeAB4AAAJzlI8Cy5sPVZst
+ QoqZPbnr6IXAJYYPE6Qqpa4O0rQpK1fGNJf5hwclsHv1FrIa0FehEYuuoMh5/CmH0hjSWsVS
+ s9FtFgr15JjNq4ZKHptHEtS647xpn2uOu0XDf+xHvdV/wjVBIshGmLUh95MIU8J4aGNRAAA7' 'Drag')
+ 
+ ('R0lGODlhHgAeAJEAAAD/AAAAAP///wAAACH5BAUUAAIALAAAAAAeAB4AAAJrlI8Cy5sPVZst
+ QoqZPbnr6IXAJYZPaSJNwLYu63HrS6cTjOGdcQeZnpHMZjSXCFh8HX0MHJLpeS6kISo1CgU4
+ s8BfsjWsfq8asXfCw54rQu8YnXZ/2TJUMGHfnfJwEn+00SYSqFJC6NcXUQAAOw==' 'Dup')
+ 
+ ('R0lGODlhHgAeAKIAAAAAAMz//2d/f5Cysv///wAAAAAAAAAAACH5BAUUAAQALAAAAAAeAB4A
+ AAOASLpM8fC1SV28sVLMoV7YIAAkIAyYhpVsmU5rK7/MJd/A1VwDK0SjEiqjiJE4QdPL+OOw
+ ljzS0JjTda6PUhPLzQq73RaYKx5fy2bnM41cs6nbqwXrls+vwXin+LbfOwNTfnwdeVgwgCyC
+ OoghinsVhSR6Hh9/D4EcljVgmxuaHwkAOw==' 'Help')
+ 
+ ('R0lGODlhHgAeAJEAAP//AAAAAP///wAAACH5BAUUAAIALAAAAAAeAB4AAAJ1lI8Cy5sPVZst
+ QoqZPbnr6IXAJYYPE6Tqui7px6Hs/AK1Y0w3Vu+jJPP0ApNcw6cj2pQaCvKofCaFUWZH6qqK
+ sMvs1urUhrjDL9U7ps3QlaS61a0AS1M5nQeOZd80uZ6vBqN3R0FC6HdyiLNBuJFA5wiC4VgA
+ ADs='  'Scale')
+ 
+ ('R0lGODlhHgAeAJEAAJycnAAAAP///wAAACH5BAUUAAIALAAAAAAeAB4AAAJplI8Cy5sPVZst
+ QoqZPbnr6IXAJYZPaSJUwLZBya1uC0vTDNAp5jJ6Z7uxhC9UYygrGnNI4nLxOzaNUd8UVYVe
+ S1mmkrr1VrjbnwE7jZ7RxWqM3Kuo2N9RYrklPT/652aN8jcnItgnZ1EAADs='  'Paint')
+ 
+ ('R0lGODlhHgAeAJEAAM7/nAAAAP///wAAACH5BAUUAAIALAAAAAAeAB4AAAJrlI8Cy5sPVZst
+ QoqZPbnr6IXAFQbmeX6IiLaqIQJmyMUzLbGBCNs7HVvcgozWbUiUGYW/pBJjbJakxaUPSg26
+ qk5misubIMGeHrkxxpiZWN46/Syv2BT4ywy3Ox7dCqi/seYWKNhBSEIRWAAAOw=='  'FontSize')
+ 
+ ('R0lGODlhHgAeAJEAAP/OzgAAAP///wAAACH5BAUUAAIALAAAAAAeAB4AAAJ3lI8Cy5sPVZst
+ QoqZPbnr6IXAJYbPEqTqiq6qgzCu286f1KR50HoGpZPxAMHMb1JEDo2Y5K6k7AmhT+LSShWy
+ tNuQjfsSBZPO0vhaFl+rHdy0uZ4c2dG2WwqMV+Zfujxm1fVGcZKFQWJ4U5i4MVfSCCgCifhn
+ UQAAOw==' 'FontStyle')
+ 
+ ('R0lGODlhHgAeAJEAAAAAAO+MKf///wAAACH5BAUUAAIALAAAAAAeAB4AAAJ0lI8Sy5sPVZst
+ QoqZPbnr6IXBJYZPaSIMwLYuu7ztaDSyHN+OlN9z8JvUVr6ZC8PrATrB0DHT9DwpUWm1hwLq
+ iDjmVvvF+LhZ8IvsSU7RnaGSCkurq9eKew1OccyT+k7Fx7XUdlImBGL4Z1G2kYDSiEjRWAAA
+ Ow=='  'FontEmph')
+ 
+ ('R0lGODlhHgAeAJEAAP///+8A7////wAAACH5BAUUAAIALAAAAAAeAB4AAAJylI8Sy5sPVZst
+ QoqZPbnr6IXBJTbAWSXlcrbAx3kv67ZwaNduKuo63/OhKiWhbcXI/ZC0WaDGbE6OTGpzuLI+
+ UdqOlurEYaUiSTK8RWcM03B3bU6f1Z2Y8g23p8ehxzw64scCaAHosBFXhhijuKiCgVgAADs='    'Recolor')
+ 
+ ('R0lGODlhHgAeAJEAAMb/xgAAAf///wAAACH5BAUUAAIALAAAAAAeAB4AAAJclI8Cy5sPVZst
+ QoqZPbnr6IXAJYZPaSKoyK2sxATyTNd0BS/2blcUD5SFZiWixzgUHpXJQLPIzCCXTmqwZ73e
+ fA3tDud6hVO5Ma5l/qjS6nXa8t6UyfJ5pk6iyAsAOw=='    'Script')
+ 
+ ) do:
+ 	[: pair  |
+ 		ScriptingSystem saveForm: ((GIFReadWriter on: (Base64MimeConverter mimeDecodeToBytes: pair first readStream) readStream) nextImage)
+ 			atKey: ('LargeHalo-', pair second) asSymbol].
+ 
+ ScriptingSystem formDictionary at: #'LargeHalo-Dismiss' put: (ScriptingSystem formDictionary at: #PinkX).
+ 
+ ScriptingSystem formDictionary at: #'LargeHalo-Collapse' put: (ScriptingSystem formDictionary at: #TanO).
+ 
+ ScriptingSystem formDictionary at: #'LargeHalo-Menu' put: (ScriptingSystem formDictionary at: #MenuIcon).
+ 
+ 
+ "
+ ScriptingSystem initializeLargeHaloIcons.
+ "!

Item was added:
+ ----- Method: StandardScriptingSystem>>initializeSmallHaloIcons (in category '*Etoys-Squeakland-utilities') -----
+ initializeSmallHaloIcons
+ 	"Build the old, smaller halo icons and stash them in the form dictionary under namees prefixed by 'Small'"
+ 
+ 	#( 'Debug'  'Dismiss'  'Rot'  'Menu'  'Tile'  'View'  'Grab'  'Drag'  'Dup'  'Help'  'Scale'  'Paint'  'FontSize'  'FontStyle'  'FontEmph'  'Recolor') with: #(
+ 
+ 	( 0 0 0 50331648 25165824 12582912 281018368 415236096 264241152 132120576 7340032 3670016 1572864 0 0 0)
+ 	( 0 0 0 0 204472320 242221056 132120576 62914560 62914560 132120576 242221056 204472320 0 0 0 0)
+ 	( 0 0 25165824 33554432 0 132120576 69730304 606339072 606339072 337641472 132120576 0 4194304 25165824 0 0)
+ 	( 0 0 0 267386880 267386880 267386880 135266304 267386880 135266304 267386880 135266304 267386880 0 0 0 0)
+ 	( 0 0 0 0 0 536346624 536346624 404226048 404226048 536346624 536346624 0 0 0 0 0)
+ 	( 0 0 0 0 132120576 486014976 770965504 1341259776 669253632 467140608 132120576 0 0 0 0 0)
+ 	( 0 25165824 25165824 37748736 69206016 135266304 268959744 669253632 338165760 204472320 69206016 69206016 132120576 0 0 0)
+ 	( 0 0 0 473432064 268959744 401080320 69206016 69206016 69206016 69206016 401080320 268959744 473432064 0 0 0)
+ 	( 0 0 0 0 528482304 276824064 284688384 277348352 285736960 520617984 17301504 33030144 0 0 0 0)
+ 	( 0 0 62914560 132120576 204472320 204472320 3145728 6291456 12582912 25165824 25165824 0 25165824 25165824 0 0)
+ 	( 0 0 0 0 265289728 139460608 139460608 139460608 139460608 265289728 1048576 267386880 0 0 0 0)
+ 	( 0 0 0 402653184 503316480 192937984 213909504 73400320 103809024 51904512 25690112 14155776 7340032 0 0 0)
+ 	( 0 0 0 15728640 8388608 8388608 8388608 243269632 148897792 142606336 209715200 142606336 142606336 0 0 0)
+ 	( 0 0 0 0 527958016 155189248 138412032 171966464 242221056 171966464 138412032 138412032 473956352 0 0 0)
+ 	( 0 0 0 0 532414464 530579456 404750336 406847488 511180800 507510784 411041792 411041792 411041792 0 0 0)
+ 	( 0 0 0 1048576 7864320 66060288 32505856 39845888 73400320 144703488 285212672 301989888 469762048 0 0 0)) do:
+ 			[:name :array |
+ 				ScriptingSystem saveForm: (Form extent: 16 at 16 depth: 1 fromArray: array offset: 0 at 0) atKey: ('SmallHalo-', name)].
+ 
+ 	ScriptingSystem saveForm: (Form extent: 10 at 16 depth: 1 fromArray: #( 0 0 0 0 503316480 2130706432 1635778560 3246391296 3246391296 3246391296 3808428032 2130706432 1006632960 0 0 0) offset: 0 at 0 ) atKey: 'SmallHalo-Collapse'.
+ 
+ 	ScriptingSystem saveForm: ((ColorForm extent: 16 at 16 depth: 1 fromArray: #( 0 0 0 473432064 536346624 229638144 267386880 106954752 62914560 132120576 267386880 536346624 511180800 0 0 0) offset: 0 at 0) colorsFromArray: #(#(1.0 1.0 1.0) #(0.0 0.0 0.004)  ) ) atKey: 'SmallHalo-Pooh'.
+ 
+ 
+ "
+ ScriptingSystem initializeSmallHaloIcons
+ "!

Item was added:
+ ----- Method: StandardScriptingSystem>>installDevelopmentFontsAndPreferences (in category '*Etoys-Squeakland-font & color choices') -----
+ installDevelopmentFontsAndPreferences
+ 	"Reinstates some of the standard olpc font choices.  This is for private use by developers who may have reset some fonts for the benefit of development work."
+ 
+ 	Preferences setListFontTo: (StrikeFont familyName: 'Accuny' size: 18).
+ 	Preferences setButtonFontTo: (StrikeFont familyName: 'Accuny' size: 9).
+ 	Preferences disable: #inboardScrollbars.
+ 	Preferences disable: #scrollBarsOnRight.
+ 
+ 	Preferences disable: #mouseOverHalos.
+ 	Preferences disable: #biggerHandles.
+ 
+ "
+ ScriptingSystem installDevelopmentFontsAndPreferences.
+ "!

Item was added:
+ ----- Method: StandardScriptingSystem>>installOLPCFontsAndPreferences (in category '*Etoys-Squeakland-font & color choices') -----
+ installOLPCFontsAndPreferences
+ 	"Assures that some of the standard olpc font and scrolling choices are installed.  This is for private use by developers who may have changed some font and scrolling preferences, for the benefit of development work."
+ 
+ 	Preferences restoreDefaultFonts.
+ 
+ 	Preferences enable: #inboardScrollbars.
+ 	Preferences enable: #scrollBarsOnRight.
+ 
+ 	Preferences enable: #mouseOverHalos.
+ 	Preferences enable: #biggerHandles.
+ 	Preferences disable: #escapeKeyProducesMenu.
+ 
+  	Preferences setParameter: #fontForBlueFileListTitle to: ((StrikeFont familyName: 'Accujen' size: 30) emphasized: 1).
+  	Preferences setParameter: #fontForBlueFileListButtons to: ((StrikeFont familyName: 'Accujen' size: 22) emphasized: 1).
+ 
+ 	false ifTrue: [ScriptingSystem installOLPCFontsAndPreferences] "to have a sender"
+ 
+ "
+ ScriptingSystem installOLPCFontsAndPreferences.
+ "!

Item was added:
+ ----- Method: StandardScriptingSystem>>macroBenchmark (in category '*Etoys-Squeakland-benchmarks') -----
+ macroBenchmark
+ 	"Transcript cr; show: ScriptingSystem macroBenchmark"
+ 	| writer |
+ 	Smalltalk garbageCollect.
+ 	writer := '' writeStream.
+ 	writer nextPutAll: '#' , SystemVersion current highestUpdate printString;
+ 		 space.
+ 	writer nextPutAll: 'memory='.
+ 	writer print: self memory;
+ 		 space.
+ 	writer nextPutAll: 'display='.
+ 	writer nextPutAll: Display width printString , 'x' , Display height printString , 'x' , Display depth printString;
+ 		 space.
+ 	self
+ 		benchmark: #benchmarkPainter
+ 		label: 'painter'
+ 		on: writer.
+ 	self
+ 		benchmark: #benchmarkViewer
+ 		label: 'viewer'
+ 		on: writer.
+ 	self
+ 		benchmark: #benchmarkScriptor
+ 		label: 'scriptor'
+ 		on: writer.
+ 	self
+ 		benchmark: #benchmarkCategory
+ 		label: 'category'
+ 		on: writer.
+ 	^ writer contents!

Item was added:
+ ----- Method: StandardScriptingSystem>>memory (in category '*Etoys-Squeakland-benchmarks') -----
+ memory
+ 	^ SmalltalkImage current  getVMParameters at: 3!

Item was changed:
  ----- Method: StandardScriptingSystem>>newScriptingSpace2 (in category '*Etoys-utilities') -----
  newScriptingSpace2
  	"Answer a complete scripting space"
  
  	| aTemplate  aPlayfield aControl |
  	
+ 	(aTemplate _ PasteUpMorph new)
- 	(aTemplate := PasteUpMorph new)
  		setNameTo: 'etoy';
  		extent: 638 @ 470;
  		color: Color white;
  		impartPrivatePresenter;
  		setProperty: #automaticPhraseExpansion toValue: true;
  		beSticky.
  	aTemplate useRoundedCorners; borderWidth: 2. 
+ 	aControl _  ScriptingSystem scriptControlButtons setToAdhereToEdge: #bottomLeft.
- 	aControl :=  ScriptingSystem scriptControlButtons setToAdhereToEdge: #bottomLeft.
  	aControl beSticky; borderWidth: 0; beTransparent.
  	aTemplate addMorphBack: aControl.
  	aTemplate presenter addTrashCan.
  
+ 	aTemplate addMorph: (aPlayfield _ PasteUpMorph new).
- 	aTemplate addMorph: (aPlayfield := PasteUpMorph new).
  	aPlayfield
  		setNameTo: 'playfield';
  		useRoundedCorners;
  		setToAdhereToEdge: #topLeft;
  		extent: 340 at 300;
  		position: aTemplate topRight - (400 at 0);
  		beSticky;
  		automaticViewing: true;
  		wantsMouseOverHalos: true.
  	aTemplate presenter standardPlayfield: aPlayfield.
+ 
+ 	aTemplate setProperty: #tutorial toValue: true.
  	
  	^ aTemplate
  
  !

Item was changed:
  ----- Method: StandardScriptingSystem>>numericComparitorsAndHelpStrings (in category '*Etoys-utilities') -----
  numericComparitorsAndHelpStrings
  	"Answer an array whose first element is the list of comparitors, and whose second element is a list of the corresponding help strings"
  
  	^ #((< <= = ~= > >= isDivisibleBy:)
+ 	 	('less than' 'less than or equal' 'equal' 'not equal' 'greater than' 'greater than or equal' 'divisible by' )) translatedNoop!
- 	 	('less than' 'less than or equal' 'equal' 'not equal' 'greater than' 'greater than or equal' 'divisible by' ))!

Item was added:
+ ----- Method: StandardScriptingSystem>>numericFunctionsAndHelpStrings (in category '*Etoys-Squeakland-utilities') -----
+ numericFunctionsAndHelpStrings
+ 	"Answer an array whose first element is the list of functions, and whose second element is a list of the corresponding help strings"
+ 
+ 	| table |
+ 	table := self tableOfNumericFunctions.  "<selector> <help-string> pairs"
+ 	^ Array with:
+ 			(table collect: [:pr | pr first])
+ 		with:
+ 			(table collect: [:pr | pr second])!

Item was added:
+ ----- Method: StandardScriptingSystem>>openInfoFlapWithLabel:helpContents:edge: (in category '*Etoys-Squeakland-help in a flap') -----
+ openInfoFlapWithLabel: aTitle helpContents: aString edge: anEdge
+ 	"Open an info flap with the given label, contents, and edge"
+ 
+ 	| aPlug outer leftStrip rightStrip titleRow aDismissButton aFlapTab |
+ 
+ 	Preferences enable: #scrollBarsOnRight.
+ 	Preferences enable: #inboardScrollbars.
+ 
+ 	aFlapTab := FlapTab new.
+ 	aFlapTab assureExtension visible: false.
+ 	aFlapTab referentMargin: (0 @ ActiveWorld sugarAllowance).
+ 
+ 	outer := HelpFlap newRow.
+ 	outer assureExtension visible: false.
+ 	outer clipSubmorphs: true.
+ 	outer beTransparent.
+ 	outer vResizing: #spaceFill; hResizing: #spaceFill.
+ 	outer layoutInset: 0; cellInset: 0; borderWidth: 0.
+ 	outer setProperty: #morphicLayerNumber toValue: 26.
+ 
+ 	leftStrip := Morph new beTransparent.
+ 	leftStrip layoutInset: 0; cellInset: 0; borderWidth: 0.
+ 	leftStrip width:  20.
+ 	leftStrip hResizing: #rigid; vResizing: #spaceFill.
+ 	outer addMorphBack: leftStrip.
+ 
+ 	rightStrip := AlignmentMorph newColumn.
+ 	rightStrip beTransparent.
+ 	rightStrip layoutInset: 0; cellInset: 0; borderWidth: 0.
+ 	outer addMorphBack: rightStrip.
+ 	outer clipSubmorphs: true.
+ 	
+ 	titleRow := AlignmentMorph newRow.
+ 	titleRow borderColor: Color veryVeryLightGray; borderWidth: 1.
+ 	titleRow hResizing: #spaceFill; vResizing: #shrinkWrap.
+ 	titleRow beTransparent.
+ 	aDismissButton := aFlapTab tanOButton.
+ 	aDismissButton actionSelector: #dismissViaHalo.
+ 	titleRow addMorphFront: aDismissButton.
+ 	titleRow addTransparentSpacerOfSize: 8 @ 0.
+ 	titleRow
+ 		addMorphBack: (StringMorph contents: aTitle font:  Preferences standardEToysTitleFont).
+ 	rightStrip addMorph: titleRow.
+ 
+ 	aPlug := PluggableTextMorph new.
+ 	aPlug width: 540.
+ 	aPlug setText: aString.
+ 	aPlug textMorph beAllFont: Preferences standardEToysFont.
+ 	aPlug retractable: false; scrollBarOnLeft: false.
+ 	aPlug hideHScrollBarIndefinitely: true.
+ 	aPlug borderColor: ScriptingSystem borderColor.	
+ 	aPlug setNameTo: aTitle.
+ 	aPlug hResizing: #spaceFill.
+ 	aPlug vResizing: #spaceFill.
+ 	rightStrip addMorphBack: aPlug.
+ 	aFlapTab referent ifNotNil: [aFlapTab referent delete].
+ 	aFlapTab referent: outer.
+ 	aFlapTab setName: aTitle edge: anEdge color: (Color r: 0.677 g: 0.935 b: 0.484).
+ 	aFlapTab submorphs first beAllFont: Preferences standardEToysFont.
+ 	ActiveWorld addMorphFront: aFlapTab.
+ 	aFlapTab adaptToWorld: ActiveWorld.
+ 	aFlapTab computeEdgeFraction.
+ 
+ 	anEdge == #left ifTrue:
+ 		[aFlapTab position: (outer left @ outer top).
+ 		outer extent: (540 @ ActiveWorld height)].
+ 	anEdge == #right ifTrue:
+ 		[aFlapTab position: ((ActiveWorld right - aFlapTab width) @ ActiveWorld top).
+ 		outer extent: (540 @ ActiveWorld height)].
+ 
+ 	outer beFlap: true.
+ 	outer color: Color green veryMuchLighter.
+ 
+ 	aPlug textMorph lock.
+ 	aFlapTab referent hide.
+ 	aFlapTab openFully.
+ 
+ 	outer beSticky.
+ 	leftStrip beSticky.
+ 	rightStrip beSticky.
+ 
+ 	ActiveWorld doOneCycle.
+ 	aPlug width: 540.
+ 	aPlug setText: aString. "hmm, again"
+ 
+ 	aPlug color: outer color.
+ 
+ 	aPlug borderWidth: 0.
+ 
+ 	aPlug textMorph contents: aString wrappedTo: 520.
+ 	aFlapTab applyThickness: 560.
+ 	aFlapTab fitOnScreen.
+ 	aFlapTab referent show.
+ 	^ aFlapTab!

Item was added:
+ ----- Method: StandardScriptingSystem>>paneColor (in category '*Etoys-Squeakland-tile colors') -----
+ paneColor
+ 	^ Color green muchLighter muchLighter!

Item was added:
+ ----- Method: StandardScriptingSystem>>putUpInfoPanelFor:title:extent: (in category '*Etoys-Squeakland-utilities') -----
+ putUpInfoPanelFor: aString title: aTitle extent: anExtent
+ 	"Put up a dismissable help panel showing the given string, with the given extent; the panel will have a slim title bar at top, by which it can be dragged, as well as dismissed."
+ 
+ 	| aPlug outer wasOnRight wasInboard |
+ 
+ 	wasOnRight := Preferences scrollBarsOnRight.
+ 	wasInboard := Preferences inboardScrollbars.
+ 	Preferences enable: #scrollBarsOnRight.
+ 	Preferences enable: #inboardScrollbars.
+ 	aPlug := PluggableTextMorph new.
+ 	aPlug extent: anExtent.
+ 	aPlug color: Color white.
+ 	aPlug setText: aString.
+ 	aPlug textMorph beAllFont: Preferences standardEToysFont.
+ 	aPlug retractable: false; scrollBarOnLeft: false.
+ 	aPlug hideHScrollBarIndefinitely: true.
+ 	aPlug borderWidth: 0.
+ 	aPlug borderColor: ScriptingSystem borderColor.	
+ 	aPlug setNameTo: aTitle.
+ 
+ 	outer := self buildPanelTitled: aTitle.
+ 	outer addMorphBack: aPlug.
+ 	aPlug textMorph lock.
+ 
+ 	outer openInWorld.
+ 	outer center: ActiveWorld center.
+ 	outer top: (ActiveWorld top + 10).
+ 
+ 	wasOnRight ifFalse: [Preferences disable: #scrollBarsOnRight].
+ 	wasInboard ifFalse: [Preferences disable: #inboardScrollbars].
+ 
+ 	"The two lines below are force the scroll bar to recompute..."
+ 	ActiveWorld doOneCycle.
+ 	aPlug setText: aString
+ 
+ "
+ ScriptingSystem putUpInfoPanelFor: AllScriptsTool new helpString title: 'Testing One Two Three' extent: 800 at 600.
+ "!

Item was added:
+ ----- Method: StandardScriptingSystem>>randomNumberTile (in category '*Etoys-Squeakland-gold box') -----
+ randomNumberTile
+ 	"Answer a new Random Number tile"
+ 
+ 	| functionPhrase argTile aPad |
+ 	functionPhrase _ FunctionTile new.
+ 	argTile := (Vocabulary vocabularyNamed: 'Number') defaultArgumentTile.
+ 	aPad := TilePadMorph new setType: #Number.
+ 	aPad addMorphBack: argTile.
+ 	functionPhrase operator: #random pad: aPad.
+ 	^ functionPhrase!

Item was added:
+ ----- Method: StandardScriptingSystem>>randomTileIconForm (in category '*Etoys-Squeakland-utilities') -----
+ randomTileIconForm
+ 	"Answer the form to use in the gold box for the random tile item."
+ 
+ 	^ self formAtKey: #randomTileIconForm!

Item was added:
+ ----- Method: StandardScriptingSystem>>removeFromSoundLibrary: (in category '*Etoys-Squeakland-sound library') -----
+ removeFromSoundLibrary: aSoundName
+ 	"Allow the user to remove a user-added sound from the Sound library."
+ 
+ 	|  found |
+ 	found := 0.
+ 	SoundTile allInstances do:
+ 		[:m |
+ 			m literal = aSoundName
+ 				ifTrue:
+ 					[m literal: 'clink'.
+ 					found := found + 1]].
+ 	SampledSound removeSoundNamed: aSoundName.
+ 	found > 0 ifTrue:
+ 		[self inform: found printString, ' tiles reverted to "clink"' translated]!

Item was added:
+ ----- Method: StandardScriptingSystem>>renameSound:newName: (in category '*Etoys-Squeakland-sound library') -----
+ renameSound: aSoundName newName: aNewName
+ 	"Change the name of a given sound "
+ 
+ 	|  found |
+ 	found := 0.
+ 	SampledSound renameSound: aSoundName newName: aNewName.
+ 	SoundTile allInstances do:
+ 		[:m |
+ 			m literal = aSoundName
+ 				ifTrue:
+ 					[m literal: aNewName.
+ 					found := found + 1]].
+ 	found > 0 ifTrue:
+ 		[self inform: found printString, ' tile(s) changed to "' translated, aNewName]!

Item was changed:
  ----- Method: StandardScriptingSystem>>reportToUser: (in category '*Etoys-utilities') -----
  reportToUser: aString
+ 	"Make a message accessible to the user. "
- 	"Make a message accessible to the user.  For the moment, we simply defer to the Transcript mechanism"
  
+ 	| trigger current baseTriggerer topTriggerer mclass sel topSelector |
+ 	trigger _ Player compiledMethodAt: #triggerScript:.
+ 	current _ thisContext.
+ 	baseTriggerer _ nil.
+ 	topTriggerer _ nil.
+ 	[current notNil] whileTrue: [
+ 		topTriggerer ifNil: [
+ 			current receiver class isUniClass ifTrue: [
+ 				"Look for the top-most uniclass script in the call chain."
+ 				sel _ current receiver class selectorAtMethod: current method setClass: [:c | mclass _ c].
+ 				mclass = current receiver class ifTrue: [
+ 					topTriggerer _ current.
+ 					topSelector _ sel.
+ 				].
+ 			].
+ 		].
+ 		(current method = trigger and: [current class == MethodContext]) ifTrue: [
+ 			"Look for the bottom-most #triggerScript: and its selector."
+ 			baseTriggerer _ current
+ 		].
+ 		current _ current sender.
+ 	].
+ 	baseTriggerer ifNotNil: [
+ 		(baseTriggerer receiver scriptInstantiationForSelector: (baseTriggerer at: 1)) resetTo: #paused ifCurrently: #ticking.
+ 	].
+ 	(topTriggerer notNil and: [topSelector notNil]) ifTrue: [
+ 		^ self eToysError:  aString, '\', topTriggerer receiver knownName, '\', topSelector.
+ 	].
+ 	self error: aString.
+ !
- 	Transcript cr; show: aString!

Item was added:
+ ----- Method: StandardScriptingSystem>>searchForSlotProtocolConflicts (in category '*Etoys-Squeakland-utilities') -----
+ searchForSlotProtocolConflicts
+ 	"Search for conflicts in slot protocol declarations.  Show details of conflicts found in the Transcript."
+ 
+ 	| aDict additions itsAdditions slotName existing |
+ 	aDict := Dictionary new.
+ 	Morph withAllSubclasses asArray do:
+ 		[:cl |
+ 			additions := cl class selectors select: [:sel | ((sel includes: $:) not) and: [sel beginsWith: 'additionsToViewerCategor']].
+ 			additions do:
+ 				[:sel | itsAdditions := sel = #additionsToViewerCategories
+ 					ifTrue:
+ 						[cl perform: sel]
+ 					ifFalse:
+ 						[Array with: (cl perform: sel)].
+ 				itsAdditions do: [:pair | pair second do:
+ 					[:m | m first == #slot ifTrue:
+ 						[slotName := m second.
+ 						existing := aDict at: slotName ifAbsent: [nil].
+ 						existing
+ 							ifNil:
+ 								[aDict at: slotName put: m]
+ 							ifNotNil:
+ 								[((existing  fourth ~= m fourth)  "type" 
+ 									or: [existing fifth ~= m fifth] "readOnly or readWrite"
+ 									or: [existing seventh ~= m seventh] "getter"
+ 									or: [existing ninth ~= m ninth] ) "setter"
+ 										ifTrue:
+ 											[Transcript cr; show: existing.
+ 											Transcript cr; show: m]]]]]]].
+ 
+ 
+ "
+ ScriptingSystem searchForSlotProtocolConflicts.
+ "!

Item was added:
+ ----- Method: StandardScriptingSystem>>seminalFunctionTile (in category '*Etoys-Squeakland-gold box') -----
+ seminalFunctionTile
+ 	"Answer a prototypical function tile"
+ 
+ 	| functionPhrase argTile aPad |
+ 	functionPhrase _ FunctionTile new.
+ 	argTile := (Vocabulary vocabularyNamed: 'Number') defaultArgumentTile.
+ 	aPad := TilePadMorph new setType: #Number.
+ 	aPad addMorphBack: argTile.
+ 	functionPhrase operator: #abs pad: aPad.
+ 	^ functionPhrase!

Item was added:
+ ----- Method: StandardScriptingSystem>>setterFeedback (in category '*Etoys-Squeakland-font & color choices') -----
+ setterFeedback
+ 
+ 	^Color 	r: 1.0 g: 0.548 b: 0.452!

Item was added:
+ ----- Method: StandardScriptingSystem>>sizeForThumbnailsInProjectSorter (in category '*Etoys-Squeakland-olpc') -----
+ sizeForThumbnailsInProjectSorter
+ 	"Answer the desired size for thumbnails in the Project Sorter."
+ 
+ 	^ 160 @ 120
+ 
+ "Historically a thumbnail size of 80 at 60 has been used; here we scale this up by 2x for the benefit of the olpc screen.  Eventually we may wish to parameterize and expose this value."!

Item was added:
+ ----- Method: StandardScriptingSystem>>sorterGridSize (in category '*Etoys-Squeakland-olpc') -----
+ sorterGridSize
+ 	"Answer the grid-size to use in the ProjectSorterMorph and confreres."
+ 
+ 	^ 32 @ 32
+ 
+ "Historically the grid for sorters has been 16 at 16, but we jack it up for OLPC, understanding that eventualliy we may want  UI whereby this parameter choice is exposed to, and is settable by, the user."!

Item was changed:
  ----- Method: StandardScriptingSystem>>standardEventStati (in category '*Etoys-customevents-custom events') -----
  standardEventStati
  	"Answer the events that can be directed to a particular morph by its event handler."
+ 	#('mouseDown'
+ 	  'mouseStillDown' 
+ 	  'mouseUp'
+ 	  'mouseEnter'
+ 	  'mouseLeave'
+ 	  'mouseEnterDragging'
+ 	  'mouseLeaveDragging') translatedNoop.
+ 	^ #( mouseDown	 "run when mouse goes down on me"
- 	^ #(mouseDown	"run when mouse goes down on me"
  		mouseStillDown	"while mouse still down"
+ 		mouseUp "when mouse comes back up"
+ 		mouseEnter 	"when mouse enters my bounds, button up"
+ 		mouseLeave  	"when mouse exits my bounds, button up"
+ 		mouseEnterDragging 	"when mouse enters my bounds, button down"
+ 		mouseLeaveDragging 	"when mouse exits my bounds, button down"
- 		mouseUp		"when mouse comes back up"
- 		mouseEnter	"when mouse enters my bounds, button up"
- 		mouseLeave	"when mouse exits my bounds, button up"
- 		mouseEnterDragging	"when mouse enters my bounds, button down"
- 		mouseLeaveDragging	"when mouse exits my bounds, button down"
  		"keyStroke"
  		"gesture"
  	)
  !

Item was changed:
  ----- Method: StandardScriptingSystem>>stepStillDown:with: (in category '*Etoys-script-control') -----
  stepStillDown: dummy with: theButton
+ 	Cursor wait showWhile: [
+ 		theButton presenter stepStillDown: dummy with: theButton
+ 	]!
- 	theButton presenter stepStillDown: dummy with: theButton!

Item was changed:
  ----- Method: StandardScriptingSystem>>stopUp:with: (in category '*Etoys-script-control') -----
  stopUp: dummy with: theButton
  	| aPresenter |
+ 	Cursor wait showWhile: [
+ 		(aPresenter _ theButton presenter) flushPlayerListCache.  "catch guys not in cache but who're running"
+ 		aPresenter stopRunningScriptsFrom: theButton
+ 	]!
- 	(aPresenter := theButton presenter) flushPlayerListCache.  "catch guys not in cache but who're running"
- 	aPresenter stopRunningScriptsFrom: theButton!

Item was added:
+ ----- Method: StandardScriptingSystem>>systemQueryPhraseWithActionString:labelled: (in category '*Etoys-Squeakland-gold box') -----
+ systemQueryPhraseWithActionString: aByteString labelled: aByteString2
+ 	"Answer a system-query-phrase with the give action-string and label."
+ 
+ 	^ ActiveWorld presenter systemQueryPhraseWithActionString: aByteString labelled: aByteString2 !

Item was added:
+ ----- Method: StandardScriptingSystem>>tableOfNumericFunctions (in category '*Etoys-Squeakland-utilities') -----
+ tableOfNumericFunctions
+ 	"Answer an array of <external function name> <actual function to call> <help string> triplets."
+ 
+ "		English on tile			selector				English balloon help"
+ 	^ #(
+ 		('abs' 					abs						'absolute value')
+ 		('arcTan'				arcTan				'angle, in radians, whose tangent is the argument')
+ 		('cos'					cos						'trigonometric cosine, argument in radians')
+ 		('cube'					cubed					'the argument times itself, times itself again')
+ 		('cubeRoot	'			cubeRoot				'cube root of the argument')
+ 		('degreeArcTan'		degreeArcTan		'angle, in degrees, whose tangent is the argument')
+ 		('degreeCos'				degreeCos				'trigonometric cosine, argument in degrees')
+ 		('degreeSin'				degreeSin				'trigonometric sine, argument in degrees')
+ 		('degreeTan'			degreeTan				'trigonometric tangent, argument in degrees')
+ 
+ 		('degreesToRadians'	degreesToRadians	'the number of degrees equivalent to the argument which is assumed to be expressed in radians')
+ 		('exp'					exp					'exponential (e to the power of the argument)')
+ 		('factorial'				safeFactorial				'the product of all the whole numbers between 1 and the argument')
+ 		('ln'						safeLn					'natural logarithm')
+ 		('log'						safeLog				'logarithm, base 10')
+ 		('negate' 			negated				'the negative of the argument')
+ 		('radiansToDegrees'	radiansToDegrees	'the number of radians equivalent to the argument, which is expressed in degrees.')
+ 		('random'				random				'a randomly chosen integer between 1 and the argument')
+ 		('round'					rounded				'the integer closest to the argument.')
+ 		('sign'					sign					'1 if argument is positive, -1 if argument is negative, 0 if argument is zero.')
+ 		('sin'						sin						'trigonometric sine, argument in radians')
+ 		('square'				squared				'the argument multiplied by itself')
+ 		('squareRoot'			safeSquareRoot		'square root of the argument')
+ 		('tan'					tan						'trigonometric tangent, argument in radians')
+ 		('truncate'				truncated				'the integer nearest to the argument toward zero')
+ 
+ 			) translatedNoop
+ 
+ 
+ "
+ 		(raisedto 		raisedTo:		'raised to the power')   
+ "!

Item was added:
+ ----- Method: StandardScriptingSystem>>tileForArgType:forCommand: (in category '*Etoys-Squeakland-utilities') -----
+ tileForArgType: aType forCommand: cmd
+ 	"Anwer a default tile to represent a datum of the given argument type, which may be either a symbol (e.g. #Color) or a class"
+ 
+ 	(aType isKindOf: Class)  "Allowed in Ted's work"
+ 		ifTrue:
+ 			[^ aType name asString newTileMorphRepresentative typeColor: Color gray].
+ 
+ 	cmd = #playSound: ifTrue: [
+ 		^ (Vocabulary vocabularyForType: aType) argumentTileForValue: 880.
+ 	].
+ 	^ (Vocabulary vocabularyForType: aType) defaultArgumentTile.
+ !

Item was added:
+ ----- Method: StandardScriptingSystem>>timesRepeatComplexOfTiles (in category '*Etoys-Squeakland-gold box') -----
+ timesRepeatComplexOfTiles
+ 	"Answer a new object comprising the timesRepeat structure."
+ 
+ 	^ TimesRepeatTile new!

Item was changed:
  ----- Method: StandardScriptingSystem>>tryButtonFor: (in category '*Etoys-utilities') -----
  tryButtonFor: aPhraseTileMorph 
  	| aButton |
+ 	aButton := ThreePhaseButtonMorph
+ 				labelSymbol: #TryIt
+ 				target: aPhraseTileMorph
+ 				actionSelector: #try
+ 				arguments: #().
- 	aButton := SimpleButtonMorph new.
- 	aButton target: aPhraseTileMorph;
- 		 actionSelector: #try;
- 		
- 		label: '!!'
- 		font: Preferences standardEToysFont;
- 		 color: Color yellow;
- 		 borderWidth: 0.
  	aButton actWhen: #whilePressed.
  	aButton balloonTextSelector: #try.
  	^ aButton!

Item was added:
+ ----- Method: StandardScriptingSystem>>yesNoComplexOfTiles (in category '*Etoys-Squeakland-gold box') -----
+ yesNoComplexOfTiles
+ 	"Answer a new object comprising the test/yes/no structure."
+ 
+ 	^ CompoundTileMorph new!

Item was added:
+ ----- Method: StandardSystemView>>cacheBitsAsTwoTone (in category '*Etoys-Squeakland-displaying') -----
+ cacheBitsAsTwoTone
+ 	^ true!

Item was added:
+ ----- Method: StandardViewer class>>sissCreateInstanceFromSexp:idref:from:to: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ sissCreateInstanceFromSexp: sexp idref: idref from: from to: to
+ 
+ 	^ nil
+ !

Item was changed:
  ----- Method: StandardViewer>>addCategoryViewerFor:atEnd: (in category 'categories') -----
  addCategoryViewerFor: categoryInfo atEnd: atEnd
  	"Add a category viewer for the given category info.  If atEnd is true, add it at the end, else add it just after the header morph"
  
  	| aViewer |
+ 	Cursor wait showWhile: [
+ 		aViewer _ self categoryViewerFor: categoryInfo.
+ 		atEnd
+ 			ifTrue:
+ 				[self addMorphBack: aViewer]
+ 			ifFalse:
+ 				[self addMorph: aViewer after: submorphs first].
+ 		aViewer establishContents.
+ 		self world ifNotNil: [self world startSteppingSubmorphsOf: aViewer].
+ 		self fitFlap.
+ 		aViewer assureCategoryFullyVisible
+ 			
+ 			
+ 	].
+ !
- 	aViewer := self categoryViewerFor: categoryInfo.
- 	atEnd
- 		ifTrue:
- 			[self addMorphBack: aViewer]
- 		ifFalse:
- 			[self addMorph: aViewer after: submorphs first].
- 	aViewer establishContents.
- 	self world ifNotNil: [self world startSteppingSubmorphsOf: aViewer].
- 	self fitFlap!

Item was changed:
  ----- Method: StandardViewer>>addHeaderMorphWithBarHeight:includeDismissButton: (in category 'initialization') -----
  addHeaderMorphWithBarHeight: anInteger includeDismissButton: aBoolean
  	"Add the header morph to the receiver, using anInteger as a guide for its height, and if aBoolean is true, include a dismiss buton for it"
  
+ 	| header aButton aTextMorph nail wrpr costs headWrapper |
+ 	header _ AlignmentMorph newRow color: Color transparent; wrapCentering: #center; cellPositioning: #leftCenter.
- 	| header aFont aButton aTextMorph nail wrpr costs headWrapper |
- 	header := AlignmentMorph newRow color: self color muchLighter; wrapCentering: #center; cellPositioning: #leftCenter.
- 	aFont := Preferences standardButtonFont.
  	aBoolean ifTrue:
+ 		[aButton _ self tanOButton.
- 		[aButton := self tanOButton.
  		header addMorph: aButton.
+ 		aButton actionSelector: #dismiss;
- 		aButton target: self;
- 				actionSelector: #dismiss;
  				setBalloonText: 'remove this entire Viewer from the screen
  don''t worry -- nothing will be lost!!.' translated.
+ 		header addTransparentSpacerOfSize: 3].
- 		header addTransparentSpacerOfSize: 4 at 1].
  
+ 	costs _ scriptedPlayer costumes.
- 	aButton := IconicButton new borderWidth: 0;
- 			labelGraphic: (ScriptingSystem formAtKey: #AddCategoryViewer); color: Color transparent; 
- 			actWhen: #buttonDown;
- 			target: self;
- 			actionSelector: #addCategoryViewer;
- 			setBalloonText: 'click here to add
- another category pane' translated;
- 			shedSelvedge.
- 	header addMorphBack: aButton.
- 	header addTransparentSpacerOfSize: 4 at 1.
- 
- 	costs := scriptedPlayer costumes.
  	costs ifNotNil:
  	[(costs size > 1 or: [costs size = 1 and: [costs first ~~ scriptedPlayer costume]]) ifTrue:
  		[header addUpDownArrowsFor: self.
+ 		"addArrowsOn: adds the box with two arrow at the front."
+ 		(wrpr _ header submorphs first) submorphs second setBalloonText: 'switch to previous costume' translated.	
+ 		wrpr submorphs first  setBalloonText: 'switch to next costume' translated].
+ 		header addTransparentSpacerOfSize: 3].	
- 		(wrpr := header submorphs last) submorphs second setBalloonText: 'switch to previous costume' translated.	
- 		wrpr submorphs first  setBalloonText: 'switch to next costume' translated]].	
  
+ 	self viewsMorph ifTrue: [scriptedPlayer costume assureExternalName].
+ 	aTextMorph _ UpdatingStringMorph new
+ 		useStringFormat;
+ 		target:  scriptedPlayer;
+ 		getSelector: #nameForViewer;
+ 		setNameTo: 'name';
+ 		font: ScriptingSystem fontForNameEditingInScriptor.
+ 	self viewsMorph ifTrue:
+ 		[aTextMorph putSelector: #setName:.
+ 		aTextMorph setProperty: #okToTextEdit toValue: true].
+ 	aTextMorph step.
+ 	header  addMorphBack: aTextMorph.
+ 	aTextMorph setBalloonText: 'Click here to edit the player''s name.' translated.	
+ 	header addMorphBack: ((self transparentSpacerOfSize: 0) hResizing: #spaceFill; color: Color red).
+ 
+ 	aButton := ThreePhaseButtonMorph
+ 				labelSymbol: #AddInstanceVariable
+ 				target: scriptedPlayer
+ 				actionSelector: #addInstanceVariable
+ 				arguments: #().
+ 	aButton setBalloonText: 'click here to add a variable
+ to this object.' translated.
+ 	header addMorphBack: aButton.
+ 
+ 	header addTransparentSpacerOfSize: 3.
+ 
+ 	nail _ (self hasProperty: #noInteriorThumbnail)
- 	nail := (self hasProperty: #noInteriorThumbnail)
  		ifFalse:
  			[ThumbnailMorph new objectToView: scriptedPlayer viewSelector: #costume]
  		ifTrue:
+ 			[ImageMorph new image: (ScriptingSystem formAtKey: #MenuIcon)].
- 			[ImageMorph new image: Cursor menu].
  	nail on: #mouseDown send: #offerViewerMenuForEvt:morph: to: scriptedPlayer.
  	header addMorphBack: nail.
  	nail setBalloonText: 'click here to get a menu
  that will allow you to
+ locate this object,
- add a variable,
  tear off a tile, etc..' translated.
  	(self hasProperty: #noInteriorThumbnail)
  		ifFalse:
  			[nail borderWidth: 3; borderColor: #raised].
  
+ 	header addTransparentSpacerOfSize: 3.
- 	header addTransparentSpacerOfSize: 5 at 5.
  
+ 	aButton _ ThreePhaseButtonMorph labelSymbol: #AddCategoryViewer.
+ 	aButton
+ 			actWhen: #buttonUp;
+ 			target: self;
+ 			actionSelector: #addCategoryViewer;
+ 			setBalloonText: 'click here to add
+ another category pane' translated.
- "	aButton := SimpleButtonMorph new target: self; actionSelector: #newEmptyScript; label: 'S' translated font: (aFont := StrikeFont familyName: #ComicBold size: 16);  color: Color transparent; borderWidth: 0; actWhen: #buttonDown.
- 	aButton setBalloonText: 'drag from here to
- create a new script
- for this object' translated.	
  	header addMorphBack: aButton.
  
- 	header addTransparentSpacerOfSize: 8 at 5."
- 	
- 	aButton := SimpleButtonMorph new target: scriptedPlayer; actionSelector: #addInstanceVariable; label: 'v' translated font: (aFont emphasized: 1);  color: Color transparent; borderWidth: 1; actWhen: #buttonUp.
- 	"aButton firstSubmorph color: Color gray."
- 	aButton setBalloonText: 'click here to add a variable
- to this object.' translated.
- 	header addMorphBack: aButton.
- 
- 	header addTransparentSpacerOfSize: 5 at 5.
- 	self viewsMorph ifTrue: [scriptedPlayer costume assureExternalName].
- 	aTextMorph := UpdatingStringMorph new
- 		useStringFormat;
- 		target:  scriptedPlayer;
- 		getSelector: #nameForViewer;
- 		setNameTo: 'name';
- 		font: ScriptingSystem fontForNameEditingInScriptor.
- 	self viewsMorph ifTrue:
- 		[aTextMorph putSelector: #setName:.
- 		aTextMorph setProperty: #okToTextEdit toValue: true].
- 	aTextMorph step.
- 	header  addMorphBack: aTextMorph.
- 	aTextMorph setBalloonText: 'Click here to edit the player''s name.' translated.	
- 
  	header beSticky.
  	anInteger > 0
  		ifTrue:
+ 			[headWrapper _ AlignmentMorph newColumn color: self color.
- 			[headWrapper := AlignmentMorph newColumn color: self color.
  			headWrapper addTransparentSpacerOfSize: (0 @ anInteger).
  			headWrapper addMorphBack: header.
  			self addMorph: headWrapper]
  		ifFalse:
  			[self addMorph: header]!

Item was added:
+ ----- Method: StandardViewer>>assureScriptsCategoryShows (in category '*Etoys-Squeakland-categories') -----
+ assureScriptsCategoryShows
+ 	"Assure that the receiver is showing a 'scripts' category."
+ 
+ 	| catSyms newCat anIndex |
+ 	((catSyms := self symbolsOfCategoriesCurrentlyShowing) includes: ScriptingSystem nameForScriptsCategory) 
+ 		ifFalse:
+ 			[newCat := self categoryViewerFor: #scripts.
+ 			anIndex := (catSyms isEmpty or: [(#(search variables) includes: catSyms first) not])
+ 				ifTrue:
+ 					[2]
+ 				ifFalse:
+ 					[(catSyms first = #search)
+ 						ifTrue:
+ 							[(catSyms size = 1 or: [catSyms second ~= #variables])
+ 								ifTrue:
+ 									[3]
+ 								ifFalse:
+ 									[4]]
+ 						ifFalse:
+ 							[3]].
+ 			self addMorph: newCat asElementNumber: anIndex]!

Item was added:
+ ----- Method: StandardViewer>>enforceImplicitSelf (in category '*Etoys-Squeakland-user interface') -----
+ enforceImplicitSelf
+ 	"If the implicitSelf preference is set to true, obscure all unnecessary objRef tiles."
+ 
+ 	self allMorphs do:
+ 		[:m | ((m isKindOf: TileMorph) and: [m type == #objRef])
+ 			ifTrue:
+ 				[m emblazonPlayerNameOnReferenceTileWithin: self]] !

Item was changed:
  ----- Method: StandardViewer>>fitFlap (in category 'initialization') -----
  fitFlap
  	(owner notNil and:[owner isFlap]) ifTrue:[
  		owner width < self fullBounds width ifTrue:[
+ 			owner assureFlapWidth: self fullBounds width.
- 			owner assureFlapWidth: self fullBounds width + 25.
  		].
  	].!

Item was changed:
  ----- Method: StandardViewer>>hasDismissButton (in category 'user interface') -----
  hasDismissButton
  	submorphs isEmptyOrNil ifTrue: [^ false].
+ 	^ (submorphs first allMorphs detect:
+ 		[:possible | possible isButton and: [possible actionSelector == #dismiss]]
+ 			ifNone: [nil]) notNil!
- 	^submorphs first allMorphs anySatisfy:
- 		[:possible |  (possible isKindOf: SimpleButtonMorph) and: [possible actionSelector == #dismiss]]!

Item was changed:
  ----- Method: StandardViewer>>initializeFor:barHeight:includeDismissButton:showCategories: (in category 'initialization') -----
  initializeFor: aPlayer barHeight: anInteger includeDismissButton: aBoolean showCategories: categoryInfo
  	"Initialize the receiver to be a look inside the given Player.  The categoryInfo, if present, describes which categories should be present in it, in which order"
  
+ 	scriptedPlayer _ aPlayer.
- 	scriptedPlayer := aPlayer.
  	self listDirection: #topToBottom;
+ 		hResizing: #spaceFill;
+ 		width: 550;
- 		hResizing: #shrinkWrap;
  		vResizing: #shrinkWrap;
+ 		layoutInset: 3;
+ 		cellInset: 3;
  		borderWidth: 1.
  	self color: self standardViewerColor.
+ 	self borderColor: ScriptingSystem borderColor.
  	self addHeaderMorphWithBarHeight: anInteger includeDismissButton: aBoolean.
  
  	categoryInfo isEmptyOrNil
  		ifFalse:  "Reincarnating an pre-existing list"
  			[categoryInfo do:
  				[:aCat | self addCategoryViewerFor: aCat]]
  		ifTrue:  "starting fresh"
  			[self addSearchPane. 
  			self addCategoryViewer.
  			self addCategoryViewer.
+  			(self categoriesCurrentlyShowing includes: ScriptingSystem nameForInstanceVariablesCategory translated) ifTrue: [self addCategoryViewer].
+  			(self categoriesCurrentlyShowing includes: ScriptingSystem nameForScriptsCategory translated) ifTrue: [self addCategoryViewer].
+ 			(scriptedPlayer isPlayerLike and: [scriptedPlayer costume isMemberOf: KedamaMorph])ifTrue: [self addCategoryViewer]]
+ !
- 			(scriptedPlayer isPlayerLike and: [scriptedPlayer costume isMemberOf: KedamaMorph]) ifTrue: [self addCategoryViewer].
- 		].!

Item was changed:
  ----- Method: StandardViewer>>likelyCategoryToShow (in category 'categories') -----
  likelyCategoryToShow
  	"Choose a category to show based on what's already showing and on some predefined heuristics"
  
+ 	| possible all aCat currVocab candidate returnIfPossible |
- 	| possible all currVocab |
  	all := (scriptedPlayer categoriesForViewer: self) asOrderedCollection.
  	possible := all copy.
  
  	currVocab := self currentVocabulary.
+ 	self categoryMorphs do:  [:m | 
+ 		aCat := currVocab categoryWhoseTranslatedWordingIs: m currentCategory.
+ 		aCat ifNotNil: [possible remove: aCat wording ifAbsent: []]].
- 	self categoryMorphs do: 
- 			[:m | 
- 			| aCat |
- 			aCat := currVocab categoryWhoseTranslatedWordingIs: m currentCategory.
- 			aCat ifNotNil: [possible remove: aCat wording ifAbsent: []]].
  
+ 	returnIfPossible := [:category | 
+ 		candidate := category translatedInDomain: 'Etoys-Tiles'.
+ 		(possible includes: candidate) ifTrue: [^ candidate]].
- 	(possible includes: ScriptingSystem nameForInstanceVariablesCategory translated) ifTrue:
- 		[^ ScriptingSystem nameForInstanceVariablesCategory].
  
+ 	scriptedPlayer hasUserDefinedSlots
+ 		ifTrue: [returnIfPossible value: ScriptingSystem nameForInstanceVariablesCategory].
+ 	scriptedPlayer hasUserDefinedScripts
+ 		ifTrue: [returnIfPossible value: ScriptingSystem nameForScriptsCategory].
+ 
+ 	#(kedama basic tests 'color & border' color flagging comparing motion geometry input preferences)
+ 		do: returnIfPossible.
+ 
+ 	candidate := possible isEmpty ifFalse: [possible first] ifTrue: [all first].
+ 	^ candidate!
- 	(currVocab isEToyVocabulary) 
- 		ifTrue: 
- 			[(possible includes: ScriptingSystem nameForScriptsCategory translated) 
- 				ifTrue: [^ ScriptingSystem nameForScriptsCategory]].
- 	{'kedama' translated. #basic translated} 
- 		do: [:preferred | (possible includes: preferred) ifTrue: [^ preferred]].
- 	((scriptedPlayer isPlayerLike) 
- 		and: [scriptedPlayer hasOnlySketchCostumes]) 
- 			ifTrue: [(possible includes: #tests translated) ifTrue: [^#tests translated]].
- 	{#'color & border' translated. #tests translated. #color translated. #flagging translated. #comparing translated.} 
- 		do: [:preferred | (possible includes: preferred) ifTrue: [^ preferred]].
- 	^ possible isEmpty ifFalse: [possible first] ifTrue: [all first]!

Item was added:
+ ----- Method: StandardViewer>>updateScriptsCategory (in category '*Etoys-Squeakland-categories') -----
+ updateScriptsCategory
+ 	"If any category viewer is showing scripts, relaunch it."
+ 
+ 	self categoryMorphs do:
+ 		[:m | 
+ 			(m chosenCategorySymbol = #scripts) ifTrue:
+ 				[m beReplacedByCategory: #scripts]]!

Item was added:
+ ----- Method: StarMorph>>nextFatter (in category '*Etoys-Squeakland-menus') -----
+ nextFatter
+ 	self makeVertices: vertices size starRatio: self nextSkip .
+ 	self computeBounds.!

Item was added:
+ ----- Method: StarMorph>>nextThinner (in category '*Etoys-Squeakland-menus') -----
+ nextThinner
+ 	self makeVertices: vertices size starRatio: self prevSkip .
+ 	self computeBounds.!

Item was added:
+ ChangeSetCategory subclass: #StaticChangeSetCategory
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tools-Changes'!
+ 
+ !StaticChangeSetCategory commentStamp: '<historical>' prior: 0!
+ StaticChangeSetCategory is a user-defined change-set category that has in it only those change sets specifically placed there.!

Item was added:
+ ----- Method: StaticChangeSetCategory>>acceptsManualAdditions (in category 'queries') -----
+ acceptsManualAdditions
+ 	"Answer whether the user is allowed manually to manipulate the contents of the change-set-category."
+ 
+ 	^ true!

Item was added:
+ ----- Method: StaticChangeSetCategory>>addChangeSet: (in category 'add') -----
+ addChangeSet: aChangeSet
+ 	"Add the change set manually"
+ 
+ 	self elementAt: aChangeSet name put: aChangeSet!

Item was added:
+ ----- Method: StaticChangeSetCategory>>includesChangeSet: (in category 'queries') -----
+ includesChangeSet: aChangeSet
+ 	"Answer whether the receiver includes aChangeSet in its retrieval list"
+ 
+ 	^ elementDictionary includesKey: aChangeSet name!

Item was added:
+ ----- Method: StaticChangeSetCategory>>reconstituteList (in category 'updating') -----
+ reconstituteList
+ 	"Reformulate the list.  Here, since we have a manually-maintained list, at this juncture we only make sure change-set-names are still up to date, and we purge moribund elements"
+ 
+ 	|  survivors |
+ 	survivors _ elementDictionary select: [:aChangeSet | aChangeSet isMoribund not].
+ 	self clear.
+ 	(survivors asSortedCollection: [:a :b | a name <= b name]) reverseDo:
+ 		[:aChangeSet | self addChangeSet: aChangeSet]!

Item was added:
+ TextMorph subclass: #StaticTextMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Basic'!
+ 
+ !StaticTextMorph commentStamp: 'sw 8/11/2004 14:33' prior: 0!
+ A TextMorph that is unwilling to be edited or rotated.!

Item was added:
+ ----- Method: StaticTextMorph>>addFlexShell (in category 'resisting rotation') -----
+ addFlexShell
+ 	"Actually, don't"!

Item was added:
+ ----- Method: StaticTextMorph>>addFlexShellIfNecessary (in category 'resisting rotation') -----
+ addFlexShellIfNecessary
+ 	"For me, it never is necessary"!

Item was added:
+ ----- Method: StaticTextMorph>>drawNullTextOn: (in category 'drawing') -----
+ drawNullTextOn: aCanvas
+ 	"Make null text frame visible"
+ 
+ 	aCanvas isPostscriptCanvas ifFalse:
+ 		[aCanvas fillRectangle: bounds color: Color transparent]!

Item was added:
+ ----- Method: StaticTextMorph>>handlesKeyboard: (in category 'event handling') -----
+ handlesKeyboard: evt
+ 	"Don't do text editing, unless the receiver is outfitted with an explicit keyboard handler."
+ 
+ 	editor _ nil. 	"just to be sure"
+ 	self eventHandler ifNotNil: [^ self eventHandler handlesKeyboard: evt].
+ 	^ false!

Item was added:
+ ----- Method: StaticTextMorph>>handlesMouseDown: (in category 'resisting rotation') -----
+ handlesMouseDown: evt
+ 	"Decline to handle text-editing-inducing mouse-downs, so that the receiver can be easily grabbed for relocation"
+ 	
+ 	| eh |
+ 	^ (eh _ self eventHandler) notNil and:
+ 		[eh handlesMouseDown: evt]!

Item was added:
+ ----- Method: StaticTextMorph>>heading: (in category 'resisting rotation') -----
+ heading: newHeading
+ 	"Set the receiver's heading (in eToy terms)"
+ 
+ 	self rotationDegrees: newHeading!

Item was added:
+ ----- Method: StaticTextMorph>>measureContents (in category 'e-toy support') -----
+ measureContents
+ 	
+ 	^ text asStringMorph measureContents!

Item was added:
+ ----- Method: StaticTextMorph>>mouseDown: (in category 'mouse-handling') -----
+ mouseDown: evt
+ 	"Don't do text-editing things, but dispatch to evt handler if appropriate"
+ 
+ 	self eventHandler ifNotNil:
+ 		[self eventHandler mouseDown: evt fromMorph: self]!

Item was added:
+ ----- Method: StaticTextMorph>>mouseUp: (in category 'mouse-handling') -----
+ mouseUp: evt
+ 	"Don't do text-editing things, but dispatch to evt handler if appropriate"
+ 	
+ 	self eventHandler ifNotNil:
+ 		[self eventHandler mouseUp: evt fromMorph: self]!

Item was added:
+ ----- Method: StaticTextMorph>>printOn: (in category 'e-toy support') -----
+ printOn: aStream
+ 	"Print the receiver on a stream."
+ 
+ 	super printOn: aStream.
+ 	aStream nextPutAll: ': '.
+ 	self contents asString printOn: aStream!

Item was added:
+ ----- Method: StaticTextMorph>>rotationDegrees: (in category 'resisting rotation') -----
+ rotationDegrees: degrees 
+ 	"Set my rotationDegreees.  This unusual code is part of the effort to make me avoid the heartbreak of rotation"
+ 
+ 	self forwardDirection: degrees!

Item was added:
+ ----- Method: StaticTextMorph>>setCharacters: (in category 'e-toy support') -----
+ setCharacters: chars
+ 	"obtain a string value from the receiver"
+ 
+ 	super setCharacters: chars.
+ 	self extent: (self measureContents x @ self extent y).!

Item was added:
+ ----- Method: StaticTextMorph>>wouldAcceptKeyboardFocusUponTab (in category 'event handling') -----
+ wouldAcceptKeyboardFocusUponTab
+ 	"Since the receiver is not user-editible by conventional means, refuse to give it the selection upon tab."
+ 
+ 	^ false!

Item was added:
+ PrintableEncoder subclass: #StoreEncoder
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-MorphicExtras-Postscript Filters'!

Item was added:
+ ----- Method: StoreEncoder class>>filterSelector (in category 'configuring') -----
+ filterSelector
+     ^#storeOnStream:.
+ !

Item was added:
+ ----- Method: StrikeFont class>>defaultFallbackTextStyle (in category '*Etoys-Squeakland-font creation') -----
+ defaultFallbackTextStyle
+ 
+ 	^  TextConstants at: #DefaultFallbackFont ifAbsent: [TextStyle named: 'Accuny'].
+ !

Item was added:
+ ----- Method: StrikeFont class>>newForSimplifiedChineseFromEFontBDFFile:name:overrideWith: (in category '*Etoys-Squeakland-instance creation') -----
+ newForSimplifiedChineseFromEFontBDFFile: fileName name: aString overrideWith: otherFileName
+ 
+ 	| n |
+ 	n _ self new.
+ 	n readEFontBDFForSimplifiedChineseFromFile: fileName name: aString overrideWith: otherFileName.
+ 	^ n.
+ !

Item was added:
+ ----- Method: StrikeFont class>>setupDefaultFallbackTextStyle (in category '*Etoys-Squeakland-font creation') -----
+ setupDefaultFallbackTextStyle
+ 
+ 	| defaultStyle |
+ 	defaultStyle := self defaultFallbackTextStyle.
+ 
+ 	(#(Accuat Accujen Accula Accumon Accusf Accushi Accuve Atlanta) collect: [:e | TextStyle named: e]) do: [:style |
+ 		style fontArray do: [:e |
+ 			e reset.
+ 			e setupDefaultFallbackTextStyleTo: defaultStyle.
+ 		].
+ 	].
+ 	TTCFont allSubInstances
+ 		do: [:e | e reset.
+ 			e setupDefaultFallbackTextStyleTo: defaultStyle]
+ 
+ !

Item was added:
+ ----- Method: StrikeFont class>>setupDefaultFallbackTextStyleTo: (in category '*Etoys-Squeakland-font creation') -----
+ setupDefaultFallbackTextStyleTo: aTextStyle
+ 
+ 	TextConstants at: #DefaultFallbackFont put: aTextStyle.
+ !

Item was added:
+ ----- Method: StrikeFont>>hasGlyphWithFallbackOf: (in category '*Etoys-Squeakland-accessing') -----
+ hasGlyphWithFallbackOf: aCharacter
+ 
+ 	(self hasGlyphOf: aCharacter) ifTrue: [^ true].
+  	^ fallbackFont ifNotNil: [fallbackFont hasGlyphWithFallbackOf: aCharacter] ifNil: [false].
+ !

Item was added:
+ ----- Method: StrikeFont>>readEFontBDFForSimplifiedChineseFromFile:name:overrideWith: (in category '*Etoys-Squeakland-file in/out') -----
+ readEFontBDFForSimplifiedChineseFromFile: fileName name: aString overrideWith: otherFileName
+ 
+ 	| fontReader stream |
+ 	fontReader _ EFontBDFFontReaderForRanges readOnlyFileNamed: fileName.
+ 	stream _ ReadStream on: (fontReader readRangesForSimplifiedChinese: fontReader rangesForSimplifiedChinese overrideWith: otherFileName otherRanges: {Array with: 16rFF00 with: 16rFF60} additionalOverrideRange: fontReader additionalRangesForSimplifiedChinese).
+ 	xTable _ stream next.
+ 	glyphs _ stream next.
+ 	minAscii _ stream next.
+ 	maxAscii _ stream next.
+ 	maxWidth _ stream next.
+ 	ascent _ stream next.
+ 	descent _ stream next.
+ 	pointSize _ stream next.
+ 	name _ aString.
+ 	type _ 0. "no one see this"
+ 	superscript _ ascent - descent // 3.	
+ 	subscript _ descent - ascent // 3.	
+ 	emphasis _ 0.
+ 	self reset.
+ !

Item was added:
+ ----- Method: StrikeFont>>setupDefaultFallbackTextStyleTo: (in category '*Etoys-Squeakland-multibyte character methods') -----
+ setupDefaultFallbackTextStyleTo: aTextStyle
+ 
+ 	| fonts f |
+ 	fonts := aTextStyle fontArray.
+ 	f _ fonts first.
+ 	f familyName = self familyName ifTrue: [^ self].
+ 	1 to: fonts size do: [:i |
+ 		self height > (fonts at: i) height ifTrue: [f _ fonts at: i].
+ 	].
+ 	self fallbackFont: f.
+ 	self reset.
+ 
+ !

Item was added:
+ ----- Method: StrikeFontSet class>>createExternalFontFileForUnicodeSimplifiedChinese: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ createExternalFontFileForUnicodeSimplifiedChinese: fileName
+ "
+ 	Smalltalk garbageCollect.
+ 	StrikeFontSet createExternalFontFileForUnicodeSimplifiedChinese: 'uSimplifiedChineseFont.out'.
+ "
+ 
+ 	| file array f installDirectory |
+ 	file _ FileStream newFileNamed: fileName.
+ 	installDirectory _ Smalltalk at: #M17nInstallDirectory ifAbsent: [].
+ 	installDirectory _ installDirectory
+ 		ifNil: [String new]
+ 		ifNotNil: [installDirectory , FileDirectory pathNameDelimiter asString].
+ 	array _ Array
+ 				with: (StrikeFont newForSimplifiedChineseFromEFontBDFFile: installDirectory , 'wenquanyi_9pt.bdf' name: 'SimplifiedChinese10' overrideWith: 'shnmk12.bdf')
+ 				with: ((StrikeFont newForSimplifiedChineseFromEFontBDFFile: installDirectory , 'wenquanyi_10pt.bdf' name: 'SimplifiedChinese12' overrideWith: 'shnmk12.bdf') "fixAscent: 14 andDescent: 1 head: 1")
+ 				with: ((StrikeFont newForSimplifiedChineseFromEFontBDFFile: installDirectory , 'wenquanyi_12pt.bdf' name: 'SimplifiedChinese14' overrideWith: 'shnmk16.bdf') fixAscent: 16 andDescent: 4 head: 4)
+ "				with: (StrikeFont newForSimplifiedChineseFromEFontBDFFile: installDirectory , 'b24.bdf' name: 'SimplifiedChinese18' overrideWith: 'gb16st.bdf')".
+ 	TextConstants at: #forceFontWriting put: true.
+ 	f _ ReferenceStream on: file.
+ 	f nextPut: array.
+ 	file close.
+ 	TextConstants removeKey: #forceFontWriting.
+ !

Item was added:
+ ----- Method: StrikeFontSet>>hasGlyphWithFallbackOf: (in category '*Etoys-Squeakland-accessing') -----
+ hasGlyphWithFallbackOf: aCharacter
+ 
+ 	| index f |
+ 	index _ aCharacter leadingChar +1.
+ 	fontArray size < index ifTrue: [^ false].
+ 	(f _ fontArray at: index) ifNil: [^ false].
+ 
+ 	^ f hasGlyphWithFallbackOf: aCharacter.
+ !

Item was added:
+ ----- Method: String class>>ccg:prolog:expr:index: (in category '*Etoys-Squeakland-plugin generation') -----
+ ccg: cg prolog: aBlock expr: aString index: anInteger
+ 
+ 	^cg 
+ 		ccgLoad: aBlock 
+ 		expr: aString 
+ 		asCharPtrFrom: anInteger
+ 		andThen: (cg ccgValBlock: 'isBytes')
+ !

Item was added:
+ ----- Method: String class>>ccgDeclareCForVar: (in category '*Etoys-Squeakland-plugin generation') -----
+ ccgDeclareCForVar: aSymbolOrString
+ 
+ 	^'char *', aSymbolOrString
+ !

Item was added:
+ ----- Method: String>>asIntegerIfAllDigits (in category '*Etoys-Squeakland-converting') -----
+ asIntegerIfAllDigits
+ 	"If the receiver consists entirely of digits, answer the integer represented, else answer nil.  Because of the all-digits requirement, a negative result is impossible."
+ 
+ 	^ self isAllDigits ifTrue: [self asNumber] ifFalse: [nil]
+ 
+ "
+ '123.4' asIntegerIfAllDigits
+ '2345678901234' asIntegerIfAllDigits
+ '-234' asIntegerIfAllDigits
+ '02398' asIntegerIfAllDigits
+ "!

Item was added:
+ ----- Method: String>>asLowercaseAlphabetic (in category '*Etoys-Squeakland-converting') -----
+ asLowercaseAlphabetic
+ 	"Return a copy of the receiver from which all non-alphabetic chars have been removed"
+ 
+ 	^ self select: [:ch | ch isLetter] thenCollect: [:l | l asLowercase]
+ 
+ 
+ " 
+ ' ? abc 8/ d   ' asLowercaseAlphabetic
+ "
+ !

Item was added:
+ ----- Method: String>>asMIMEType (in category '*Etoys-Squeakland-network-mime') -----
+ asMIMEType
+ 	^MIMEType fromMIMEString: self!

Item was added:
+ ----- Method: String>>asPangoAttributes (in category '*Etoys-Squeakland-pango') -----
+ asPangoAttributes
+ 
+ 	^ Array new: 0.
+ !

Item was added:
+ ----- Method: String>>composeAccents (in category '*Etoys-Squeakland-converting') -----
+ composeAccents
+ 
+ 	| stream |
+ 	stream _ UnicodeCompositionStream on: (String new: 16).
+ 	self do: [:e | stream nextPut: e].
+ 	^ stream contents.
+ !

Item was added:
+ ----- Method: String>>findLastOccuranceOfString:startingAt: (in category '*Etoys-Squeakland-deprecated-3.10') -----
+ findLastOccuranceOfString: subString startingAt: start 
+ 	"Answer the index of the last occurance of subString within the receiver, starting at start. If 
+ 	the receiver does not contain subString, answer 0."
+ 
+ 	^ self findLastOccurrenceOfString: subString startingAt: start
+ !

Item was added:
+ ----- Method: String>>fromCamelCase (in category '*Etoys-Squeakland-converting') -----
+ fromCamelCase
+ 	"convert 'anExampleString'  to 'an example  string'"
+ 
+ 	| upper nextWord start |
+ 	upper := ($A to: $Z) asCharacterSet.
+ 	nextWord := self indexOfAnyOf: upper.
+ 	nextWord = 0 ifTrue: [^self].
+ 	start := 1.
+ 
+ 	^String streamContents: [:strm |
+ 		[
+ 			strm nextPutAll: (self copyFrom: start to: nextWord-1).
+ 			strm space; nextPut: (self at: nextWord) asLowercase.
+ 			start := nextWord+1.
+ 			nextWord := self indexOfAnyOf: upper startingAt: start.
+ 			nextWord = 0
+ 		] whileFalse.
+ 		strm nextPutAll: (self copyFrom: start to: self size).
+ 	].!

Item was added:
+ ----- Method: String>>getInteger32: (in category '*Etoys-Squeakland-encoding') -----
+ getInteger32: location
+ 	| integer |
+ 	<primitive: 'getInteger' module: 'IntegerPokerPlugin'>
+ 	"^IntegerPokerPlugin doPrimitive: #getInteger"
+ 
+ 	"the following is about 7x faster than interpreting the plugin if not compiled"
+ 
+ 	integer := 
+ 		((self at: location) asInteger bitShift: 24) +
+ 		((self at: location+1) asInteger bitShift: 16) +
+ 		((self at: location+2) asInteger bitShift: 8) +
+ 		(self at: location+3) asInteger.
+ 
+ 	integer > 1073741824 ifTrue: [^1073741824 - integer ].
+ 	^integer
+ !

Item was added:
+ ----- Method: String>>isReallyString (in category '*Etoys-Squeakland-testing') -----
+ isReallyString
+ 	^ true!

Item was added:
+ ----- Method: String>>passwordFor: (in category '*Etoys-Squeakland-password compatibility') -----
+ passwordFor: aServerDir
+ 
+ 	^ self.
+ !

Item was added:
+ ----- Method: String>>putInteger32:at: (in category '*Etoys-Squeakland-encoding') -----
+ putInteger32: anInteger at: location
+ 	| integer |
+ 	<primitive: 'putInteger' module: 'IntegerPokerPlugin'>
+ 	"IntegerPokerPlugin doPrimitive: #putInteger"
+ 
+ 	"the following is close to 20x faster than the above if the primitive is not compiled"
+ 	"PUTCOUNTER _ PUTCOUNTER + 1."
+ 	integer _ anInteger.
+ 	integer < 0 ifTrue: [integer :=  1073741824 - integer. ].
+ 	self at: location+3 put: (Character value: (integer \\ 256)).
+ 	self at: location+2 put: (Character value: (integer bitShift: -8) \\ 256).
+ 	self at: location+1 put: (Character value: (integer bitShift: -16) \\ 256).
+ 	self at: location put: (Character value: (integer bitShift: -24) \\ 256).
+ 
+ "Smalltalk at: #PUTCOUNTER put: 0"!

Item was added:
+ ----- Method: String>>sunitMatch: (in category '*Etoys-Squeakland-Camp Smalltalk') -----
+ sunitMatch: aString
+ 
+         ^(self match: aString)
+ 		and: [aString numArgs = 0]!

Item was added:
+ ----- Method: String>>toCamelCase (in category '*Etoys-Squeakland-converting') -----
+ toCamelCase
+ 	"convert 'an example  string' to 'anExampleString'"
+ 
+ 	(self includes: Character space) ifFalse: [^self].
+ 	^String streamContents: [:strm |
+ 		| space start |
+ 		space := self indexOf: Character space.
+ 		strm nextPutAll: (self copyFrom: 1 to: space-1).
+ 		[	[start := space+1.
+ 			space := self indexOf: Character space startingAt: start.
+ 			space = start] whileTrue.
+ 			space = 0 ifTrue: [space := self size+1].
+ 			start <= self size ifTrue: [
+ 				strm nextPut: (self at: start) asUppercase.
+ 				strm nextPutAll: (self copyFrom: start+1 to: space-1)].
+ 			space < self size
+ 		] whileTrue].!

Item was added:
+ ----- Method: StringHolder class>>windowColorSpecification (in category '*Etoys-Squeakland-window color') -----
+ windowColorSpecification
+ 	"Answer a WindowColorSpec object that declares my preference"
+ 
+ 	^ WindowColorSpec classSymbol: self name wording: 'Workspace' translatedNoop brightColor: #lightYellow pastelColor: #paleYellow helpMessage: 'A place for text in a window.' translatedNoop!

Item was added:
+ ----- Method: StringMorph>>mimeTypes (in category '*Etoys-Squeakland-drop outside') -----
+ mimeTypes
+ 	"Supported mime types for drag out"
+ 	^ #('UTF8_STRING')!

Item was added:
+ ----- Method: StringMorph>>usePango (in category '*Etoys-support') -----
+ usePango
+ 	^ self
+ 		valueOfProperty: #usePango
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: StringMorph>>usePango: (in category '*Etoys-support') -----
+ usePango: aBoolean
+ 	^ self
+ 		setProperty: #usePango
+ 		toValue: aBoolean!

Item was added:
+ ----- Method: StringSocket>>remoteSocketAddress (in category '*Etoys-Squeakland-as yet unclassified') -----
+ remoteSocketAddress
+ 
+ 	^ socket remoteSocketAddress!

Item was added:
+ Object subclass: #StrokePoint
+ 	instanceVariableNames: 'position prev next flags'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Graphics-Tools-Simplification'!

Item was added:
+ ----- Method: StrokePoint class>>on: (in category 'instance creation') -----
+ on: aPoint
+ 	^self new on: aPoint!

Item was added:
+ ----- Method: StrokePoint>>backwardDirection (in category 'accessing') -----
+ backwardDirection
+ 	"Compute the backward direction to the previous point in the stroke."
+ 	| dir |
+ 	dir _ prev ifNil:[0 at 0] ifNotNil:[self position - prev position].
+ 	dir isZero ifFalse:[dir _ dir normalized].
+ 	^dir!

Item was added:
+ ----- Method: StrokePoint>>defineIntermediatePoint (in category 'accessing') -----
+ defineIntermediatePoint
+ 	"Define an intermediate point for an extreme change in direction"
+ 	| pt |
+ 	pt _ self class on: position.
+ 	pt width: self width.
+ 	pt prevPoint: self.
+ 	pt nextPoint: next.
+ 	next ifNotNil:[next prevPoint: pt].
+ 	self nextPoint: pt.
+ 	pt isFinal: self isFinal.!

Item was added:
+ ----- Method: StrokePoint>>do: (in category 'enumerating') -----
+ do: aBlock
+ 	aBlock value: self.
+ 	next ifNotNil:[next do: aBlock].!

Item was added:
+ ----- Method: StrokePoint>>forwardDirection (in category 'accessing') -----
+ forwardDirection
+ 	"Compute the forward direction to the next point in the stroke."
+ 	| dir |
+ 	dir _ next ifNil:[0 at 0] ifNotNil:[next position - self position].
+ 	dir isZero ifFalse:[dir _ dir normalized].
+ 	^dir!

Item was added:
+ ----- Method: StrokePoint>>intersectFrom:with:to:with: (in category 'intersecting') -----
+ intersectFrom: startPt with: startDir to: endPt with: endDir
+ 	"Compute the intersection of two lines, e.g., compute alpha and beta for
+ 		startPt + (alpha * startDir) = endPt + (beta * endDir).
+ 	Reformulating this yields
+ 		(alpha * startDir) - (beta * endDir) = endPt - startPt.
+ 	or
+ 		(alpha * startDir) + (-beta * endDir) = endPt - startPt.
+ 	or
+ 		(alpha * startDir x) + (-beta * endDir x) = endPt x - startPt x.
+ 		(alpha * startDir y) + (-beta * endDir y) = endPt y - startPt y.
+ 	which is trivial to solve using Cramer's rule. Note that since
+ 	we're really only interested in the intersection point we need only
+ 	one of alpha or beta since the resulting intersection point can be
+ 	computed based on either one."
+ 	| det deltaPt alpha |
+ 	det _ (startDir x * endDir y) - (startDir y * endDir x).
+ 	det = 0.0 ifTrue:[^nil]. "There's no solution for it"
+ 	deltaPt _ endPt - startPt.
+ 	alpha _ (deltaPt x * endDir y) - (deltaPt y * endDir x).
+ 	alpha _ alpha / det.
+ 	"And compute intersection"
+ 	^startPt + (alpha * startDir)!

Item was added:
+ ----- Method: StrokePoint>>isFinal (in category 'flags') -----
+ isFinal
+ 	^flags anyMask: 1!

Item was added:
+ ----- Method: StrokePoint>>isFinal: (in category 'flags') -----
+ isFinal: aBool
+ 	flags _ aBool ifTrue:[flags bitOr: 1] ifFalse:[flags bitClear: 1].
+ 	(aBool and:[prev notNil and:[prev isFinal not]]) ifTrue:[prev isFinal: true].!

Item was added:
+ ----- Method: StrokePoint>>isProcessed (in category 'flags') -----
+ isProcessed
+ 	^flags anyMask: 2!

Item was added:
+ ----- Method: StrokePoint>>isProcessed: (in category 'flags') -----
+ isProcessed: aBool
+ 	flags _ aBool ifTrue:[flags bitOr: 2] ifFalse:[flags bitClear: 2].!

Item was added:
+ ----- Method: StrokePoint>>nextPoint (in category 'accessing') -----
+ nextPoint
+ 	"Return the next point in the stroke"
+ 	^next!

Item was added:
+ ----- Method: StrokePoint>>nextPoint: (in category 'accessing') -----
+ nextPoint: aPoint
+ 	"Set the next point in the stroke"
+ 	next _ aPoint!

Item was added:
+ ----- Method: StrokePoint>>on: (in category 'initialize') -----
+ on: aPoint
+ 	flags _ 0.
+ 	self position: aPoint.!

Item was added:
+ ----- Method: StrokePoint>>position (in category 'accessing') -----
+ position
+ 	"Return the position of the receiver"
+ 	^position!

Item was added:
+ ----- Method: StrokePoint>>position: (in category 'accessing') -----
+ position: aPoint
+ 	"Set the position of the receiver to aPoint"
+ 	position _ aPoint.!

Item was added:
+ ----- Method: StrokePoint>>prevPoint (in category 'accessing') -----
+ prevPoint
+ 	"Return the previous point of the stroke"
+ 	^prev!

Item was added:
+ ----- Method: StrokePoint>>prevPoint: (in category 'accessing') -----
+ prevPoint: aPoint
+ 	"Set the previous point of the stroke"
+ 	prev _ aPoint!

Item was added:
+ ----- Method: StrokePoint>>printOn: (in category 'printing') -----
+ printOn: aStream
+ 	super printOn: aStream.
+ 	aStream nextPut:$(; print: position; nextPut:$).!

Item was added:
+ ----- Method: StrokePoint>>releaseCachedState (in category 'initialize') -----
+ releaseCachedState!

Item was added:
+ ----- Method: StrokePoint>>removeIntermediatePoint (in category 'accessing') -----
+ removeIntermediatePoint
+ 	"Remove an intermediate point for an extreme change in direction"
+ 	next ifNil:[^self].
+ 	prev ifNil:[^self].
+ 	next position = self position ifTrue:[
+ 		next _ next nextPoint.
+ 		next ifNotNil:[next prevPoint: self].
+ 		^self removeIntermediatePoint]!

Item was added:
+ Object subclass: #StrokeSimplifier
+ 	instanceVariableNames: 'points firstPoint finalPoint lastPoint lastStrokePoint lastStrokeIndex distance samples time removeDuplicates simplifyStroke maxDistance maxSamples maxTime'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Graphics-Tools-Simplification'!
+ 
+ !StrokeSimplifier commentStamp: '<historical>' prior: 0!
+ I represent a very simple algorithm for simplifying an input stroke. See class side for an example.!

Item was added:
+ ----- Method: StrokeSimplifier class>>flattenExample (in category 'examples') -----
+ flattenExample		"StrokeSimplifier flattenExample"
+ 	"This example demonstrate how aggressive the stroke recorder simplifies series of points"
+ 	| pts fc lastPt nextPt |
+ 	[Sensor anyButtonPressed] whileFalse.
+ 	fc _ FormCanvas on: Display.
+ 	pts _ self new.
+ 	lastPt _ Sensor cursorPoint.
+ 	pts add: lastPt.
+ 	[Sensor anyButtonPressed] whileTrue:[
+ 		nextPt _ Sensor cursorPoint.
+ 		nextPt = lastPt ifFalse:[
+ 			fc line: lastPt to: nextPt width: 3 color: Color black.
+ 			pts add: nextPt.
+ 			lastPt _ nextPt.
+ 		].
+ 	].
+ 	pts closeStroke.
+ 	(PolygonMorph vertices: pts finalStroke color: Color transparent borderWidth: 3 borderColor: Color black) makeOpen; addHandles; openInWorld.
+ !

Item was added:
+ ----- Method: StrokeSimplifier class>>new (in category 'instance creation') -----
+ new
+ 	^self basicNew initialize.!

Item was added:
+ ----- Method: StrokeSimplifier class>>smoothen:length: (in category 'instance creation') -----
+ smoothen: pointList length: unitLength
+ 	| prevPt curPt nextPt out prevMid nextMid segment length steps deltaT |
+ 	out _ WriteStream on: (Array new: pointList size).
+ 	prevPt _ pointList at: pointList size-1.
+ 	curPt _ pointList last.
+ 	prevMid _ (curPt + prevPt) * 0.5.
+ 	1 to: pointList size do:[:i|
+ 		nextPt _ pointList at: i.
+ 		nextMid _ (nextPt + curPt) * 0.5.
+ 		segment _ Bezier2Segment from: prevMid to: nextMid via: curPt.
+ 		length _ segment length.
+ 		steps _ (length / unitLength) asInteger.
+ 		steps < 1 ifTrue:[steps _ 1].
+ 		deltaT _ 1.0 / steps.
+ 		1 to: steps-1 do:[:k|
+ 			out nextPut: (segment valueAt: deltaT * k)].
+ 		out nextPut: nextMid.
+ 		prevPt _ curPt.
+ 		curPt _ nextPt.
+ 		prevMid _ nextMid.
+ 	].
+ 	^out contents!

Item was added:
+ ----- Method: StrokeSimplifier>>add: (in category 'public') -----
+ add: aPoint
+ 	lastPoint ifNotNil:[
+ 		(aPoint = lastPoint position and:[removeDuplicates]) ifTrue:[^false].
+ 	].
+ 	self addPoint: aPoint.
+ 	^true!

Item was added:
+ ----- Method: StrokeSimplifier>>addFirstPoint (in category 'simplification') -----
+ addFirstPoint
+ 	"No points in stroke yet. Add the very first point."
+ 	self addNextPoint.
+ 	finalPoint _ firstPoint _ lastPoint.
+ 	self addPoint: firstPoint position.!

Item was added:
+ ----- Method: StrokeSimplifier>>addLastPoint (in category 'simplification') -----
+ addLastPoint
+ 	self addNextPoint.
+ !

Item was added:
+ ----- Method: StrokeSimplifier>>addNextPoint (in category 'simplification') -----
+ addNextPoint
+ 	lastStrokePoint ifNotNil:[
+ 		lastStrokePoint releaseCachedState.
+ 		lastStrokePoint nextPoint: lastPoint.
+ 		lastPoint prevPoint: lastStrokePoint.
+ 		self simplifyLineFrom: lastPoint.
+ 	].
+ 	lastStrokePoint _ lastPoint.
+ 	distance _ 0. "Distance since last stroke point"
+ 	samples _ 0.	 "Samples since last stroke point"
+ 	time _ 0. "Time since last stroke point"!

Item was added:
+ ----- Method: StrokeSimplifier>>addPoint: (in category 'simplification') -----
+ addPoint: aPoint
+ 	| strokePoint |
+ 	strokePoint _ self asStrokePoint: aPoint.
+ 	strokePoint prevPoint: lastPoint.
+ 	lastPoint ifNotNil:[
+ 		lastPoint do:[:pt| lastPoint _ pt].
+ 		lastPoint nextPoint: strokePoint.
+ 		lastPoint releaseCachedState].
+ 	lastPoint _ strokePoint.
+ 	points add: strokePoint.
+ 	simplifyStroke ifTrue:[self simplifyIncrementally].
+ !

Item was added:
+ ----- Method: StrokeSimplifier>>asStrokePoint: (in category 'private') -----
+ asStrokePoint: aPoint
+ 	^StrokePoint on: aPoint!

Item was added:
+ ----- Method: StrokeSimplifier>>closeStroke (in category 'public') -----
+ closeStroke
+ 	"Close the current stroke"
+ 	lastPoint do:[:pt| lastPoint _ pt].
+ 	lastPoint nextPoint: firstPoint.
+ 	self simplifyLineFrom: firstPoint.
+ 	firstPoint _ firstPoint nextPoint.
+ 	self simplifyLineFrom: firstPoint.
+ 	firstPoint _ firstPoint nextPoint.
+ 	self simplifyLineFrom: firstPoint.
+ 	firstPoint prevPoint nextPoint: nil.
+ 	firstPoint prevPoint: nil.	!

Item was added:
+ ----- Method: StrokeSimplifier>>currentStroke (in category 'public') -----
+ currentStroke
+ 	"Return a copy of the current stroke.
+ 	As far as we have it, that is."
+ 	| pts |
+ 	pts _ WriteStream on: (Array new: 100).
+ 	firstPoint do:[:pt| pts nextPut: pt position].
+ 	^pts contents!

Item was added:
+ ----- Method: StrokeSimplifier>>finalStroke (in category 'public') -----
+ finalStroke
+ 	"Return the final stroke"
+ 	^self currentStroke!

Item was added:
+ ----- Method: StrokeSimplifier>>finalizeStroke (in category 'public') -----
+ finalizeStroke
+ 	"Finalize the current stroke, e.g., remove the last point(s) if necessary"
+ 	| prevPt |
+ 	prevPt _ lastPoint prevPoint.
+ 	(prevPt prevPoint == nil or:[prevPt position = lastPoint position]) 
+ 		ifFalse:[lastPoint _ prevPt].
+ 	lastPoint nextPoint: nil.
+ 	firstPoint do:[:pt| pt isFinal: true].!

Item was added:
+ ----- Method: StrokeSimplifier>>firstPoint (in category 'public') -----
+ firstPoint
+ 	^firstPoint!

Item was added:
+ ----- Method: StrokeSimplifier>>initialize (in category 'initialize') -----
+ initialize
+ 	removeDuplicates _ true.
+ 	simplifyStroke _ true.
+ 	maxDistance _ 10 squared.
+ 	maxSamples _ 10.
+ 	maxTime _ 1000.
+ 	self reset.!

Item was added:
+ ----- Method: StrokeSimplifier>>next (in category 'public') -----
+ next
+ 	"Returns the next 'final' point, e.g., one that will not be affected by simplification later"
+ 	| thePoint |
+ 	(finalPoint notNil and:[finalPoint isFinal]) ifFalse:[^nil].
+ 	thePoint _ finalPoint.
+ 	finalPoint _ finalPoint nextPoint.
+ 	^thePoint!

Item was added:
+ ----- Method: StrokeSimplifier>>pointsDo: (in category 'public') -----
+ pointsDo: aBlock
+ 	firstPoint ifNil:[^self].
+ 	firstPoint do: aBlock.!

Item was added:
+ ----- Method: StrokeSimplifier>>reset (in category 'initialize') -----
+ reset
+ 	points _ OrderedCollection new: 100.
+ 	lastPoint _ nil.
+ 	lastStrokePoint _ nil.!

Item was added:
+ ----- Method: StrokeSimplifier>>simplifyIncrementally (in category 'simplification') -----
+ simplifyIncrementally
+ 	"Simplify the last point that was added"
+ 	| prevPt dir |
+ 	lastStrokePoint ifNil:[^self addFirstPoint].
+ 	prevPt _ (points at: points size-1).
+ 	dir _ lastPoint position - prevPt position.
+ 	distance _ distance + (dir dotProduct: dir). "e.g., distance^2"
+ 	samples _ samples + 1.
+ 	"time _ time + (points last key - (points at: points size-1) key)."
+ 	"If we have sampled too many points or went too far,
+ 	add the next point. This may eventually result in removing earlier points."
+ 	(samples >= maxSamples or:[distance >= maxDistance "or:[time > maxTime]"]) 
+ 		ifTrue:[^self addNextPoint].
+ 	"Note: We may want to add a time/speed feature in the future."!

Item was added:
+ ----- Method: StrokeSimplifier>>simplifyLineFrom: (in category 'simplification') -----
+ simplifyLineFrom: p5
+ 	"Remove a point if it represents the intermediate point of a line.
+ 	We only remove 'inner' points of a line, that is, for a sequence of points like
+ 
+ 	p1----p2----p3----p4---p5
+ 
+ 	we will remove only p3. This is so that any curve can be adequately represented, e.g., so that for a stroke running like:
+ 
+ 		p0
+ 		 |
+ 		p1----p2----p3----p4----p5
+ 							   |
+ 							   |
+ 							  p6
+ 	we will neither touch p2 (required for the curve p0,p1,p2) nor p5 yet (the shape of the curve relies on p6 which is not yet recorded."
+ 	| p4 p3 p2 p1 d1 d2 d3 d4 cosValue |
+ 	p4 _ p5 prevPoint ifNil:[^self].
+ 	"Note: p4 (actually p1 from above) is final after we know the next point."
+ 	p3 _ p4 prevPoint ifNil:[^p4 isFinal: true].
+ 	p2 _ p3 prevPoint ifNil:[^self].
+ 	p1 _ p2 prevPoint ifNil:[^self].
+ 	"First, compute the change in direction at p3 (this is the point we are *really* interested in)."
+ 	d2 _ p2 forwardDirection.
+ 	d3 _ p3 forwardDirection.
+ 	cosValue _ d2 dotProduct: d3.
+ 
+ 	"See if the change is below the threshold for linearity.
+ 	Note that the above computes the cosine of the directional change
+ 	at p2,p3,p4 so that a value of 1.0 means no change at all, and -1.0
+ 	means a reversal of 180 degrees."
+ 	cosValue < 0.99 ifTrue:[
+ 		"0.999 arcCos radiansToDegrees is approx. 2.56 degrees.
+ 		If the cosine is less than we consider this line to be curved."
+ 		^p2 isFinal: true]. "we're done here"
+ 
+ 	"Okay, so the line is straight. Now make sure that the previous and the
+ 	next segment are straight as well (so that we don't remove a point which
+ 	defines the start/end of a curved segment)"
+ 
+ 	d1 _ p1 forwardDirection.
+ 	cosValue _ d1 dotProduct: d2.
+ 	cosValue < 0.95 ifTrue:[
+ 		"0.99 arcCos radiansToDegrees is approx. 8 degrees"
+ 		^p2 isFinal: true].
+ 
+ 	"And the same for the last segment"
+ 	d4 _ p4 forwardDirection.
+ 	cosValue _ d3 dotProduct: d4.
+ 	cosValue < 0.95 ifTrue:[
+ 		"0.99 arcCos radiansToDegrees is approx. 8 degrees"
+ 		^p2 isFinal: true].
+ 
+ 	"Okay, so p3 defines an inner point of a pretty straight line.
+ 	Let's get rid of it."
+ 	p2 nextPoint: p4.
+ 	p4 prevPoint: p2.
+ 	p2 releaseCachedState.
+ 	p3 releaseCachedState.
+ 	p4 releaseCachedState.!

Item was added:
+ Object subclass: #Subdivision
+ 	instanceVariableNames: 'area startingEdge point1 point2 point3 stamp outlineThreshold'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Graphics-Tools-Triangulation'!
+ 
+ !Subdivision commentStamp: '<historical>' prior: 0!
+ I perform (constraint) delauney triangulations on a set of points. See my class side for examples.!

Item was added:
+ ----- Method: Subdivision class>>constraintOutline: (in category 'instance creation') -----
+ constraintOutline: pointCollection
+ 	^(self points: pointCollection shuffled) constraintOutline: pointCollection!

Item was added:
+ ----- Method: Subdivision class>>example1 (in category 'examples') -----
+ example1	"Subdivision example1"
+ 	| ptList subdivision |
+ 	ptList _ ((5 to: 35) collect:[:i| i*10 at 50]),
+ 			{350 at 75. 70 at 75. 70 at 100},
+ 			((7 to: 35) collect:[:i| i*10 at 100]),
+ 			{350 at 125. 50 at 125}.
+ 	subdivision _ self points: ptList.
+ 	self exampleDraw: subdivision points: ptList.
+ !

Item was added:
+ ----- Method: Subdivision class>>example2 (in category 'examples') -----
+ example2	"Subdivision example2"
+ 	"Same as example1, but this time using the outline constraints"
+ 	| ptList subdivision |
+ 	ptList _ ((5 to: 35) collect:[:i| i*10 at 50]),
+ 			{350 at 75. 70 at 75. 70 at 100},
+ 			((7 to: 35) collect:[:i| i*10 at 100]),
+ 			{350 at 125. 50 at 125}.
+ 	subdivision _ (self points: ptList) constraintOutline: ptList; yourself.
+ 	self exampleDraw: subdivision points: ptList.
+ !

Item was added:
+ ----- Method: Subdivision class>>example3 (in category 'examples') -----
+ example3	"Subdivision example3"
+ 	"Same as example2 but marking edges"
+ 	| ptList subdivision |
+ 	ptList _ ((5 to: 35) collect:[:i| i*10 at 50]),
+ 			{350 at 75. 70 at 75. 70 at 100},
+ 			((7 to: 35) collect:[:i| i*10 at 100]),
+ 			{350 at 125. 50 at 125}.
+ 	subdivision _ (self points: ptList) constraintOutline: ptList; yourself.
+ 	subdivision markExteriorEdges.
+ 	self exampleDraw: subdivision points: ptList.
+ !

Item was added:
+ ----- Method: Subdivision class>>example4 (in category 'examples') -----
+ example4	"Subdivision example4"
+ 	"A nasty self-intersecting shape"
+ 	"Same as example2 but marking edges"
+ 	| ptList subdivision |
+ 	ptList _ {
+ 		50 at 100. 
+ 		100 at 100.
+ 		150 at 100.
+ 		150 at 150.
+ 		100 at 150.
+ 		100 at 100.
+ 		100 at 50.
+ 		300 at 50.
+ 		300 at 300.
+ 		50 at 300.
+ 	}.
+ 	subdivision _ (self points: ptList) constraintOutline: ptList; yourself.
+ 	subdivision markExteriorEdges.
+ 	self exampleDraw: subdivision points: ptList.
+ !

Item was added:
+ ----- Method: Subdivision class>>exampleDraw:points: (in category 'examples') -----
+ exampleDraw: subdivision points: ptList
+ 	| canvas |
+ 	Display fillWhite.
+ 	canvas _ Display getCanvas.
+ 	subdivision edgesDo:[:e|
+ 		canvas line: e origin to: e destination width: 1 color: e classificationColor].
+ 	ptList do:[:pt|
+ 		canvas fillRectangle: (pt - 1 extent: 3 at 3) color: Color red.
+ 	].
+ 	Display restoreAfter:[].!

Item was added:
+ ----- Method: Subdivision class>>points: (in category 'instance creation') -----
+ points: pointCollection
+ 	^self new points: pointCollection!

Item was added:
+ ----- Method: Subdivision class>>withSize: (in category 'instance creation') -----
+ withSize: rectangle
+ 	^self new withSize: rectangle!

Item was added:
+ ----- Method: Subdivision>>assureEdgeFrom:to:lastEdge: (in category 'constraints') -----
+ assureEdgeFrom: lastPt to: nextPt lastEdge: lastEdge
+ 	"Find and return the edge connecting nextPt and lastPt.
+ 	lastEdge starts at lastPt so we can simply run around all
+ 	the edges at lastPt and find one that ends in nextPt.
+ 	If none is found, subdivide between lastPt and nextPt."
+ 	| nextEdge destPt |
+ 	nextEdge _ lastEdge.
+ 	[destPt _ nextEdge destination.
+ 	destPt x = nextPt x and:[destPt y = nextPt y]] whileFalse:[
+ 		nextEdge _ nextEdge originNext.
+ 		nextEdge = lastEdge ifTrue:[
+ 			"Edge not found. Subdivide and start over"
+ 			nextEdge _ self insertEdgeFrom: lastPt to: nextPt lastEdge: lastEdge.
+ 			nextEdge ifNil:[^nil].
+ 		].
+ 	].
+ 	nextEdge isBorderEdge: true.
+ 	^nextEdge
+ !

Item was added:
+ ----- Method: Subdivision>>assureEdgeFrom:to:lastEdge:into: (in category 'constraints') -----
+ assureEdgeFrom: lastPt to: nextPt lastEdge: lastEdge into: outPoints
+ 	"Find and return the edge connecting nextPt and lastPt.
+ 	lastEdge starts at lastPt so we can simply run around all
+ 	the edges at lastPt and find one that ends in nextPt.
+ 	If none is found, subdivide between lastPt and nextPt."
+ 	| nextEdge destPt |
+ 	nextEdge _ lastEdge.
+ 	[destPt _ nextEdge destination.
+ 	destPt x = nextPt x and:[destPt y = nextPt y]] whileFalse:[
+ 		nextEdge _ nextEdge originNext.
+ 		nextEdge = lastEdge ifTrue:[
+ 			"Edge not found. Subdivide and start over"
+ 			nextEdge _ self insertEdgeFrom: lastPt to: nextPt lastEdge: lastEdge into: outPoints.
+ 			nextEdge ifNil:[^nil].
+ 		].
+ 	].
+ 	nextEdge isBorderEdge: true.
+ 	^nextEdge
+ !

Item was added:
+ ----- Method: Subdivision>>constraintOutline: (in category 'constraints') -----
+ constraintOutline: pointList
+ 	"Make sure all line segments in the given closed outline appear in the triangulation."
+ 	| lastPt nextPt lastEdge nextEdge outPoints |
+ 	outlineThreshold ifNil:[outlineThreshold _ 1.0e-3].
+ 	lastPt _ pointList last.
+ 	lastEdge _ self locatePoint: lastPt.
+ 	lastEdge origin = lastPt 
+ 		ifFalse:[lastEdge _ lastEdge symmetric].
+ 	outPoints := WriteStream on: (Array new: pointList size).
+ 	1 to: pointList size do:[:i|
+ 		nextPt _ pointList at: i.
+ 		lastPt = nextPt ifFalse:[
+ 			nextEdge _ self assureEdgeFrom: lastPt to: nextPt lastEdge: lastEdge into: outPoints.
+ 			outPoints nextPut: nextPt.
+ 			nextEdge ifNil:[
+ 				nextEdge _ self locatePoint: nextPt.
+ 				lastEdge destination = nextPt 
+ 					ifFalse:[lastEdge _ lastEdge symmetric].
+ 			].
+ 			lastEdge _ nextEdge symmetric originNext].
+ 		lastPt _ nextPt.
+ 	].
+ 	^outPoints contents!

Item was added:
+ ----- Method: Subdivision>>debugDraw (in category 'private') -----
+ debugDraw
+ 	| scale ofs |
+ 	scale _ 100.
+ 	ofs _ 400.
+ 	self edgesDo:[:e|
+ 		Display getCanvas line: e origin * scale + ofs to: e destination * scale + ofs width: 3 color: e classificationColor].!

Item was added:
+ ----- Method: Subdivision>>edges (in category 'accessing') -----
+ edges
+ 	"Return the triangulation edges"
+ 	| edges |
+ 	edges := IdentitySet new: 500.
+ 	startingEdge first collectQuadEdgesInto:edges.
+ 	"Build line segments"
+ 	edges := edges collect:[:edge | 
+ 				LineSegment from: edge first origin to: edge first destination].
+ 	"Remove the outer triangulation edges"
+ 	^edges select:[:edge|
+ 			area origin <= edge start and:[edge start <= area corner and:[area origin <= edge end and:[edge end <= area corner]]]]!

Item was added:
+ ----- Method: Subdivision>>edgesDo: (in category 'private') -----
+ edgesDo: aBlock
+ 	startingEdge first edgesDo: aBlock stamp: (stamp _ stamp + 1).!

Item was added:
+ ----- Method: Subdivision>>faces (in category 'accessing') -----
+ faces
+ 	"Construct and return triangles"
+ 	| firstEdge nextEdge lastEdge |
+ 	firstEdge _ nextEdge _ startingEdge first.
+ 	[lastEdge _ nextEdge.
+ 	nextEdge _ nextEdge originNext.
+ 	nextEdge == firstEdge] whileFalse:[
+ 		"Make up a triangle between lastEdge and nextEdge"
+ 	].
+ !

Item was added:
+ ----- Method: Subdivision>>findEdgeFrom:to:lastEdge: (in category 'constraints') -----
+ findEdgeFrom: lastPt to: nextPt lastEdge: lastEdge
+ 	"Find and return the edge connecting nextPt and lastPt.
+ 	lastEdge starts at lastPt so we can simply run around all
+ 	the edges at lastPt and find one that ends in nextPt."
+ 	| nextEdge destPt |
+ 	nextEdge _ lastEdge.
+ 	[destPt _ nextEdge destination.
+ 	destPt x = nextPt x and:[destPt y = nextPt y]] whileFalse:[
+ 		nextEdge _ nextEdge originNext.
+ 		nextEdge = lastEdge ifTrue:[^nil].
+ 	].
+ 	^nextEdge!

Item was added:
+ ----- Method: Subdivision>>flagExteriorEdgesFrom:to:direction: (in category 'constraints') -----
+ flagExteriorEdgesFrom: lastEdge to: nextEdge direction: thisWay
+ 	| tmpEdge |
+ 	lastEdge isBorderEdge ifFalse:[self error: 'not border'].
+ 	nextEdge isBorderEdge ifFalse:[self error: 'not border'].
+ 	tmpEdge := lastEdge.
+ 	thisWay ifTrue:[
+ 		[tmpEdge := tmpEdge originNext.
+ 		tmpEdge == nextEdge] whileFalse:[
+ 			tmpEdge isBorderEdge ifTrue:[self error: 'border'].
+ 			tmpEdge isExteriorEdge: true.
+ 		].
+ 	] ifFalse:[
+ 		[tmpEdge := tmpEdge originPrev.
+ 		tmpEdge == nextEdge] whileFalse:[
+ 			tmpEdge isBorderEdge ifTrue:[self error: 'border'].
+ 			tmpEdge isExteriorEdge: true.
+ 		].
+ 	].!

Item was added:
+ ----- Method: Subdivision>>innerTriangleEdgesDo: (in category 'private') -----
+ innerTriangleEdgesDo: aBlock
+ 	startingEdge first triangleEdges: (stamp _ stamp + 1) do:
+ 		[:e1 :e2 :e3|
+ 			self assert:[e1 origin = e3 destination].
+ 			self assert:[e2 origin = e1 destination].
+ 			self assert:[e3 origin = e2 destination].
+ 			(e1 isExteriorEdge or:[e2 isExteriorEdge or:[e3 isExteriorEdge]]) ifFalse:[
+ 				aBlock value: e1 value: e2 value: e3.
+ 			].
+ 		].
+ !

Item was added:
+ ----- Method: Subdivision>>innerTriangleVerticesDo: (in category 'private') -----
+ innerTriangleVerticesDo: aBlock
+ 	startingEdge first triangleEdges: (stamp _ stamp + 1) do:
+ 		[:e1 :e2 :e3|
+ 			self assert:[e1 origin = e3 destination].
+ 			self assert:[e2 origin = e1 destination].
+ 			self assert:[e3 origin = e2 destination].
+ 			(e1 isExteriorEdge or:[e2 isExteriorEdge or:[e3 isExteriorEdge]]) ifFalse:[
+ 				aBlock value: e1 origin value: e2 origin value: e3 origin.
+ 			].
+ 		].
+ !

Item was added:
+ ----- Method: Subdivision>>innerTriangles (in category 'private') -----
+ innerTriangles
+ 	| out |
+ 	out _ WriteStream on: (Array new: 100).
+ 	self innerTriangleVerticesDo:[:p1 :p2 :p3| out nextPut: {p1. p2. p3}].
+ 	^out contents!

Item was added:
+ ----- Method: Subdivision>>insertEdgeFrom:to:lastEdge: (in category 'constraints') -----
+ insertEdgeFrom: lastPt to: nextPt lastEdge: prevEdge
+ 	| midPt lastEdge nextEdge dst |
+ 	dst _ lastPt - nextPt.
+ 	(dst dotProduct: dst) < outlineThreshold ifTrue:[^nil].
+ 	midPt _ lastPt interpolateTo: nextPt at: 0.5.
+ 	self insertPoint: midPt.
+ 	lastEdge _ prevEdge.
+ 	nextEdge _ self assureEdgeFrom: lastPt to: midPt lastEdge: lastEdge.
+ 	nextEdge ifNil:[^nil].
+ 	lastEdge _ nextEdge symmetric originNext.
+ 	nextEdge _ self assureEdgeFrom: midPt to: nextPt lastEdge: lastEdge.
+ 	^nextEdge!

Item was added:
+ ----- Method: Subdivision>>insertEdgeFrom:to:lastEdge:into: (in category 'constraints') -----
+ insertEdgeFrom: lastPt to: nextPt lastEdge: prevEdge into: outPoints
+ 	| midPt lastEdge nextEdge dst |
+ 	dst _ lastPt - nextPt.
+ 	(dst dotProduct: dst) < outlineThreshold ifTrue:[^nil].
+ 	midPt _ lastPt interpolateTo: nextPt at: 0.5.
+ 	self insertPoint: midPt.
+ 	lastEdge _ prevEdge.
+ 	nextEdge _ self assureEdgeFrom: lastPt to: midPt lastEdge: lastEdge into: outPoints.
+ 	outPoints nextPut: midPt.
+ 	nextEdge ifNil:[^nil].
+ 	lastEdge _ nextEdge symmetric originNext.
+ 	nextEdge _ self assureEdgeFrom: midPt to: nextPt lastEdge: lastEdge into: outPoints.
+ 	^nextEdge!

Item was added:
+ ----- Method: Subdivision>>insertPoint: (in category 'triangulation') -----
+ insertPoint: aPoint
+ 	"Inserts a new point into a subdivision representing a Delaunay
+ 	triangulation, and fixes the affected edges so that the result
+ 	is still a Delaunay triangulation. This is based on the
+ 	pseudocode from Guibas and Stolfi (1985) p.120, with slight
+ 	modifications and a bug fix."
+ 	| edge base |
+ 	(area origin <= aPoint and:[aPoint <= area corner]) ifFalse:[self halt].
+ 	edge := self locatePoint: aPoint.
+ 	(edge origin = aPoint or:[edge destination = aPoint]) ifTrue:[^self].
+ 	(edge isPointOn: aPoint) ifTrue:[
+ 		edge := edge originPrev.
+ 		edge originNext deleteEdge].
+ 	"Connect the new point to the vertices of the containing
+ 	triangle (or quadrilateral, if the new point fell on an
+ 	existing edge.)"
+ 	base := self quadEdgeClass new.
+ 	(base first) origin: edge origin; destination: aPoint.
+ 	base first spliceEdge: edge.
+ 	startingEdge := base.
+ 	[base := edge connectEdge: base first symmetric.
+ 	edge := base first originPrev.
+ 	edge leftNext == startingEdge first] whileFalse.
+ 	"Examine suspect edges to ensure that the Delaunay condition is satisfied."
+ 	[true] whileTrue:[ | t |
+ 	t := edge originPrev.
+ 	((edge isRightPoint: t destination) and:[
+ 		self insideCircle: aPoint with: edge origin with: t destination with: edge destination])
+ 			 ifTrue:[
+ 					edge swapEdge.
+ 					edge := edge originPrev.
+ 	] ifFalse:[
+ 		(edge originNext == startingEdge first) ifTrue:[^self]. "No more suspect edges"
+ 		"pop a suspect edge"
+ 		edge := edge originNext leftPrev]].!

Item was added:
+ ----- Method: Subdivision>>insertSpine (in category 'constraints') -----
+ insertSpine
+ 	| ptList start end |
+ 	ptList _ WriteStream on: (Array new: 100).
+ 	self edgesDo:[:e|
+ 		(e isBorderEdge or:[e isExteriorEdge]) ifFalse:[
+ 			start _ e origin.
+ 			end _ e destination.
+ 			ptList nextPut: (start + end * 0.5).
+ 		].
+ 	].
+ 	ptList contents do:[:pt| self insertPoint: pt].!

Item was added:
+ ----- Method: Subdivision>>insideCircle:with:with:with: (in category 'triangulation') -----
+ insideCircle: aPoint with: a with: b with: c
+ 	"Returns TRUE if the point d is inside the circle defined by the
+ 	points a, b, c. See Guibas and Stolfi (1985) p.107."
+ 	^(((a dotProduct: a) * (self triArea: b with: c with: aPoint)) -
+ 	((b dotProduct: b) * (self triArea: a with: c with: aPoint)) +
+ 	((c dotProduct: c) * (self triArea: a with: b with: aPoint)) -
+ 	((aPoint dotProduct: aPoint) * (self triArea: a with: b with: c))) > 0.0!

Item was added:
+ ----- Method: Subdivision>>locatePoint: (in category 'triangulation') -----
+ locatePoint: aPoint
+ 	"Returns an edge e, s.t. either x is on e, or e is an edge of
+ 	a triangle containing x. The search starts from startingEdge
+ 	and proceeds in the general direction of x. Based on the
+ 	pseudocode in Guibas and Stolfi (1985) p.121."
+ 
+ 	| edge |
+ 	edge := startingEdge first.
+ 	[true] whileTrue:[
+ 		(aPoint = edge origin or:[aPoint = edge destination]) ifTrue:[^edge].
+ 		(edge isRightPoint: aPoint) ifTrue:[edge := edge symmetric]
+ 		ifFalse:[(edge originNext isRightPoint: aPoint) ifFalse:[edge := edge originNext]
+ 		ifTrue:[(edge destPrev isRightPoint: aPoint) ifFalse:[edge := edge destPrev]
+ 		ifTrue:[^edge]]]].!

Item was added:
+ ----- Method: Subdivision>>markExteriorEdges (in category 'constraints') -----
+ markExteriorEdges
+ 	"Recursively flag all edges that are known to be exterior edges.
+ 	If the outline shape is not simple this may result in marking all edges."
+ 	| firstEdge |
+ 	firstEdge _ self locatePoint: point1.
+ 	firstEdge origin = point1 
+ 		ifFalse:[firstEdge _ firstEdge symmetric].
+ 	firstEdge markExteriorEdges: (stamp _ stamp + 1).!

Item was added:
+ ----- Method: Subdivision>>markExteriorEdges:in: (in category 'constraints') -----
+ markExteriorEdges: thisWay in: pointList
+ 	"Mark edges as exteriors"
+ 	| lastPt nextPt lastEdge nextEdge |
+ 	lastPt _ pointList last.
+ 	lastEdge _ self locatePoint: lastPt.
+ 	lastEdge origin = lastPt 
+ 		ifFalse:[lastEdge _ lastEdge symmetric].
+ 	nextEdge _ self findEdgeFrom: lastPt to: (pointList atWrap: pointList size-1) lastEdge: lastEdge.
+ 	lastEdge := nextEdge.
+ 	1 to: pointList size do:[:i|
+ 		nextPt _ pointList at: i.
+ 		lastPt = nextPt ifFalse:[
+ 			nextEdge _ self findEdgeFrom: lastPt to: nextPt lastEdge: lastEdge.
+ 			nextEdge ifNil:[
+ 				nextEdge _ self locatePoint: nextPt.
+ 				lastEdge destination = nextPt 
+ 					ifFalse:[lastEdge _ lastEdge symmetric].
+ 			] ifNotNil:[
+ 				self flagExteriorEdgesFrom: lastEdge to: nextEdge direction: thisWay.
+ 			].
+ 			lastEdge _ nextEdge symmetric].
+ 		lastPt _ nextPt.
+ 	].
+ !

Item was added:
+ ----- Method: Subdivision>>outlineThreshold (in category 'accessing') -----
+ outlineThreshold
+ 	"Return the current outline threshold.
+ 	The outline threshold determines when to stop recursive
+ 	subdivision of outline edges in the case of non-simple
+ 	(that is self-intersecting) polygons."
+ 	^outlineThreshold!

Item was added:
+ ----- Method: Subdivision>>outlineThreshold: (in category 'accessing') -----
+ outlineThreshold: aNumber
+ 	"Set the current outline threshold.
+ 	The outline threshold determines when to stop recursive
+ 	subdivision of outline edges in the case of non-simple
+ 	(that is self-intersecting) polygons."
+ 	outlineThreshold _ aNumber!

Item was added:
+ ----- Method: Subdivision>>p1:p2:p3: (in category 'initialize-release') -----
+ p1: pt1 p2: pt2 p3: pt3
+ 	| ea eb ec |
+ 	point1 _ pt1.
+ 	point2 _ pt2.
+ 	point3 _ pt3.
+ 	stamp _ 0.
+ 	ea := self quadEdgeClass new.
+ 	(ea first) origin: pt1; destination: pt2.
+ 	eb := self quadEdgeClass new.
+ 	self splice: ea first symmetric with: eb first.
+ 	(eb first) origin: pt2; destination: pt3.
+ 	ec := self quadEdgeClass new.
+ 	self splice: eb first symmetric with: ec first.
+ 	(ec first) origin: pt3; destination: pt1.
+ 	self splice: ec first symmetric with: ea first.
+ 	startingEdge := ea.
+ !

Item was added:
+ ----- Method: Subdivision>>points: (in category 'accessing') -----
+ points: pointCollection
+ 
+ 	| min max |
+ 	pointCollection isEmpty ifTrue:[
+ 		min := -1.0 at -1.0.
+ 		max := 1.0 at 1.0.
+ 	] ifFalse:[
+ 		min := max := pointCollection anyOne.
+ 		pointCollection do:[:p|
+ 			min := min min: p.
+ 			max := max max: p]].
+ 	self withSize: (min corner: max).
+ 	pointCollection do:[:p| self insertPoint: p].!

Item was added:
+ ----- Method: Subdivision>>quadEdgeClass (in category 'private') -----
+ quadEdgeClass
+ 	^SubdivisionQuadEdge!

Item was added:
+ ----- Method: Subdivision>>splice:with: (in category 'triangulation') -----
+ splice: edge1 with: edge2
+ 
+ 	edge1 spliceEdge: edge2!

Item was added:
+ ----- Method: Subdivision>>startingEdge (in category 'accessing') -----
+ startingEdge
+ 	^startingEdge!

Item was added:
+ ----- Method: Subdivision>>triArea:with:with: (in category 'triangulation') -----
+ triArea: a with: b with: c
+ 	"Returns twice the area of the oriented triangle (a, b, c), i.e., the
+ 	area is positive if the triangle is oriented counterclockwise."
+ 	^((b x - a x) * (c y - a y)) - ((b y - a y) * (c x - a x))!

Item was added:
+ ----- Method: Subdivision>>trianglesDo: (in category 'private') -----
+ trianglesDo: aBlock
+ 	"Return the full triangulation of the receiver"
+ 	startingEdge first triangleEdges: (stamp _ stamp + 1) do: aBlock.
+ !

Item was added:
+ ----- Method: Subdivision>>withSize: (in category 'initialize-release') -----
+ withSize: aRectangle
+ 
+ 	| offset scale p1 p2 p3 |
+ 	area := aRectangle.
+ 	"Construct a triangle containing area"
+ 	offset := area origin.
+ 	scale := area extent.
+ 	p1 := (-1 at -1) * scale + offset.
+ 	p2 := (2 at -1) * scale + offset.
+ 	p3 := (0.5 at 3) * scale + offset.
+ 	self p1: p1 p2: p2 p3: p3.!

Item was added:
+ Object subclass: #SubdivisionHalfEdge
+ 	instanceVariableNames: 'id point quadEdge next'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Graphics-Tools-Triangulation'!
+ 
+ !SubdivisionHalfEdge commentStamp: '<historical>' prior: 0!
+ I represent a half-edge within a subdivision.!

Item was added:
+ ----- Method: SubdivisionHalfEdge class>>splice:with: (in category 'accessing') -----
+ splice: edge1 with: edge2
+ 	"This operator affects the two edge rings around the origins of a and b,
+ 	and, independently, the two edge rings around the left faces of a and b.
+ 	In each case, (i) if the two rings are distinct, Splice will combine
+ 	them into one; (ii) if the two are the same ring, Splice will break it
+ 	into two separate pieces.
+ 	Thus, Splice can be used both to attach the two edges together, and
+ 	to break them apart. See Guibas and Stolfi (1985) p.96 for more details
+ 	and illustrations."
+ 	| alpha beta t1 t2 t3 t4 |
+ 	alpha := edge1 originNext rotated.
+ 	beta := edge2 originNext rotated.
+ 
+ 	t1 := edge2 originNext.
+ 	t2 := edge1 originNext.
+ 	t3 := beta originNext.
+ 	t4 := alpha originNext.
+ 
+ 	edge1 next: t1.
+ 	edge2 next: t2.
+ 	alpha next: t3.
+ 	beta next: t4.!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>ccw:with:with: (in category 'private') -----
+ ccw: a with: b with: c
+ 
+ 	^(self triArea: a with: b with: c) > 0.0!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>center (in category 'accessing') -----
+ center
+ 	^self origin + self destination * 0.5!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>classificationColor (in category 'accessing') -----
+ classificationColor
+ 	^quadEdge classificationColor!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>classificationIndex (in category 'accessing') -----
+ classificationIndex
+ 	"Return the classification index of the receiver"
+ 	^quadEdge classificationIndex!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>collectQuadEdgesInto: (in category 'private') -----
+ collectQuadEdgesInto: aSet
+ 
+ 	(aSet includes: quadEdge) ifTrue:[^self].
+ 	aSet add: quadEdge.
+ 	self originNext collectQuadEdgesInto: aSet.
+ 	self originPrev collectQuadEdgesInto: aSet.
+ 	self destNext collectQuadEdgesInto: aSet.
+ 	self destPrev collectQuadEdgesInto: aSet.
+ 	^aSet!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>connectEdge: (in category 'topological operators') -----
+ connectEdge: edge
+ 	"Add a new edge e connecting the destination of a to the
+ 	origin of b, in such a way that all three have the same
+ 	left face after the connection is complete.
+ 	Additionally, the data pointers of the new edge are set."
+ 	| e |
+ 	e := self quadEdgeClass new.
+ 	e first spliceEdge: self leftNext.
+ 	e first symmetric spliceEdge: edge.
+ 	(e first) origin: self destination; destination: edge origin.
+ 	^e!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>deleteEdge (in category 'topological operators') -----
+ deleteEdge
+ 
+ 	self spliceEdge: self originPrev.
+ 	self symmetric spliceEdge: self symmetric originPrev.!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>destNext (in category 'accessing') -----
+ destNext
+ 	"Return the next ccw edge around (into) the destination of the current edge."
+ 	^self symmetric originNext symmetric!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>destPrev (in category 'accessing') -----
+ destPrev
+ 	"Return the next cw edge around (into) the destination of the current edge."
+ 	^self inverseRotated originNext inverseRotated!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>destination (in category 'accessing') -----
+ destination
+ 	^self symmetric origin!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>destination: (in category 'accessing') -----
+ destination: aPoint
+ 	self symmetric origin: aPoint!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>displayOn:at:withSize:stamp: (in category 'private') -----
+ displayOn: aGraphicsContext at: aPoint withSize: scaling stamp: timeStamp
+ 
+ 	| v1 v2 |
+ 	(quadEdge timeStamp = timeStamp) ifTrue:[^self].
+ 	quadEdge timeStamp: timeStamp.
+ 	v1 := self origin.
+ 	v2 := self destination.
+ 	aGraphicsContext 
+ 		displayLineFrom: (v1 * scaling)+aPoint
+ 		to: (v2 * scaling) + aPoint.
+ 	self originNext displayOn: aGraphicsContext at: aPoint withSize: scaling stamp: timeStamp.
+ 	self originPrev displayOn: aGraphicsContext at: aPoint withSize: scaling stamp: timeStamp.
+ 	self destNext displayOn: aGraphicsContext at: aPoint withSize: scaling stamp: timeStamp.
+ 
+ 	self destPrev displayOn: aGraphicsContext at: aPoint withSize: scaling stamp: timeStamp.!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>edgesDo:stamp: (in category 'enumeration') -----
+ edgesDo: aBlock stamp: timeStamp
+ 	(quadEdge timeStamp = timeStamp) ifTrue:[^self].
+ 	quadEdge timeStamp: timeStamp.
+ 	aBlock value: self.
+ 	self originNext edgesDo: aBlock stamp: timeStamp.
+ 	self originPrev edgesDo: aBlock stamp: timeStamp.
+ 	self destNext edgesDo: aBlock stamp: timeStamp.
+ 	self destPrev edgesDo: aBlock stamp: timeStamp.!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>end (in category 'accessing') -----
+ end
+ 	^self destination!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>id:owner: (in category 'initialize-release') -----
+ id: aNumber owner: aDelauneyQuadEdge
+ 
+ 	id := aNumber.
+ 	quadEdge := aDelauneyQuadEdge.!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>inverseRotated (in category 'accessing') -----
+ inverseRotated
+ 	" Return the dual of the current edge, directed from its left to its right."
+ 	^quadEdge edges at: (id > 1 ifTrue:[id-1] ifFalse:[id+3])!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>isBorderEdge (in category 'accessing') -----
+ isBorderEdge
+ 	^quadEdge isBorderEdge!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>isBorderEdge: (in category 'accessing') -----
+ isBorderEdge: aBool
+ 	quadEdge isBorderEdge: aBool!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>isExteriorEdge (in category 'accessing') -----
+ isExteriorEdge
+ 	^quadEdge isExteriorEdge!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>isExteriorEdge: (in category 'accessing') -----
+ isExteriorEdge: aBool
+ 	quadEdge isExteriorEdge: aBool!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>isInteriorEdge (in category 'accessing') -----
+ isInteriorEdge
+ 	^quadEdge isInteriorEdge!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>isInteriorEdge: (in category 'accessing') -----
+ isInteriorEdge: aBool
+ 	quadEdge isInteriorEdge: aBool!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>isLeftPoint: (in category 'private') -----
+ isLeftPoint: aPoint
+ 
+ 	^self ccw: aPoint with: self origin with: self destination
+ !

Item was added:
+ ----- Method: SubdivisionHalfEdge>>isPointOn: (in category 'private') -----
+ isPointOn: aPoint
+ 	"A predicate that determines if the point x is on the edge e.
+ 	The point is considered on if it is in the EPS-neighborhood
+ 	of the edge"
+ 	| v1 v2 u v |
+ 	v1 := aPoint - self origin.
+ 	v2 := self destination - self origin.
+ 	u := v1 dotProduct: v2.
+ 	v := v1 crossProduct: v2.
+ 	^(u isZero and:[v isZero])!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>isRightPoint: (in category 'private') -----
+ isRightPoint: aPoint
+ 
+ 	^self ccw: aPoint with: self destination with: self origin!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>leftNext (in category 'accessing') -----
+ leftNext
+ 	"Return the ccw edge around the left face following the current edge."
+ 	^self inverseRotated originNext rotated!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>leftPrev (in category 'accessing') -----
+ leftPrev
+ 	"Return the ccw edge around the left face before the current edge."
+ 	^self originNext symmetric!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>length (in category 'accessing') -----
+ length
+ 	^self start dist: self end!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>markExteriorEdges: (in category 'enumeration') -----
+ markExteriorEdges: timeStamp
+ 	| nextEdge |
+ 	quadEdge timeStamp = timeStamp ifTrue:[^self].
+ 	quadEdge timeStamp: timeStamp.
+ 	self isExteriorEdge: true.
+ 	nextEdge _ self.
+ 	[nextEdge _ nextEdge originNext.
+ 	nextEdge == self or:[nextEdge isBorderEdge]] whileFalse:[
+ 		nextEdge symmetric markExteriorEdges: timeStamp.
+ 	].
+ 	nextEdge _ self.
+ 	[nextEdge _ nextEdge originPrev.
+ 	nextEdge == self or:[nextEdge isBorderEdge]] whileFalse:[
+ 		nextEdge symmetric markExteriorEdges: timeStamp.
+ 	].!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>next: (in category 'accessing') -----
+ next: aDelauneyEdge
+ 
+ 	next := aDelauneyEdge.!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>nextBorderEdge (in category 'accessing') -----
+ nextBorderEdge
+ 	| edge |
+ 	edge _ self originNext.
+ 	[edge == self] whileFalse:[
+ 		edge isBorderEdge ifTrue:[^edge symmetric].
+ 		edge _ edge originNext].
+ 	^nil!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>origin (in category 'accessing') -----
+ origin
+ 	^point!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>origin: (in category 'accessing') -----
+ origin: aPoint
+ 	point := aPoint!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>originNext (in category 'accessing') -----
+ originNext
+ 	"Return the next ccw edge around (from) the origin of the current edge."
+ 	^next!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>originPrev (in category 'accessing') -----
+ originPrev
+ 	" Return the next cw edge around (from) the origin of the current edge."
+ 	^self rotated originNext rotated!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>printOn: (in category 'printing') -----
+ printOn: aStream
+ 
+ 	aStream
+ 		nextPutAll: self class name;
+ 		nextPut:$(;
+ 		print: (self origin);
+ 		nextPut:$/;
+ 		print: self destination;
+ 		nextPut:$);
+ 		yourself!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>quadEdge (in category 'accessing') -----
+ quadEdge
+ 	^quadEdge!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>quadEdgeClass (in category 'private') -----
+ quadEdgeClass
+ 	^SubdivisionQuadEdge!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>rightNext (in category 'accessing') -----
+ rightNext
+ 	"Return the edge around the right face ccw following the current edge."
+ 	^self rotated originNext inverseRotated!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>rightPrev (in category 'accessing') -----
+ rightPrev
+ 	"Return the edge around the right face ccw before the current edge."
+ 	^self symmetric originNext!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>rotated (in category 'accessing') -----
+ rotated
+ 	" Return the dual of the current edge, directed from its right to its left"
+ 	^quadEdge edges at: (id < 4 ifTrue:[id+1] ifFalse:[id-3])!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>spliceEdge: (in category 'topological operators') -----
+ spliceEdge: edge
+ 	"This operator affects the two edge rings around the origins of a and b,
+ 	and, independently, the two edge rings around the left faces of a and b.
+ 	In each case, (i) if the two rings are distinct, Splice will combine
+ 	them into one; (ii) if the two are the same ring, Splice will break it
+ 	into two separate pieces.
+ 	Thus, Splice can be used both to attach the two edges together, and
+ 	to break them apart. See Guibas and Stolfi (1985) p.96 for more details
+ 	and illustrations."
+ 	| alpha beta t1 t2 t3 t4 |
+ 	alpha := self originNext rotated.
+ 	beta := edge originNext rotated.
+ 
+ 	t1 := edge originNext.
+ 	t2 := self originNext.
+ 	t3 := beta originNext.
+ 	t4 := alpha originNext.
+ 
+ 	self next: t1.
+ 	edge next: t2.
+ 	alpha next: t3.
+ 	beta next: t4.!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>squaredLength (in category 'accessing') -----
+ squaredLength
+ 	^self start dotProduct: self end!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>start (in category 'accessing') -----
+ start
+ 	^self origin!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>swapEdge (in category 'topological operators') -----
+ swapEdge
+ 	"Essentially turns edge e counterclockwise inside its enclosing
+ 	quadrilateral. The data pointers are modified accordingly."
+ 
+ 	| a b |
+ 	a := self originPrev.
+ 	b := self symmetric originPrev.
+ 	self spliceEdge: a.
+ 	self symmetric spliceEdge: b.
+ 	self spliceEdge: a leftNext.
+ 	self symmetric spliceEdge: b leftNext.
+ 	self origin: a destination; destination: b destination.!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>symmetric (in category 'accessing') -----
+ symmetric
+ 	"Return the edge from the destination to the origin of the current edge."
+ 	^quadEdge edges at:(id < 3 ifTrue:[id+2] ifFalse:[id - 2]).!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>timeStamp (in category 'accessing') -----
+ timeStamp
+ 	^quadEdge timeStamp!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>triArea:with:with: (in category 'private') -----
+ triArea: a with: b with: c
+ 	"Returns twice the area of the oriented triangle (a, b, c), i.e., the
+ 	area is positive if the triangle is oriented counterclockwise."
+ 	^((b x - a x) * (c y - a y)) - ((b y - a y) * (c x - a x))!

Item was added:
+ ----- Method: SubdivisionHalfEdge>>triangleEdges:do: (in category 'enumeration') -----
+ triangleEdges: timeStamp do: aBlock
+ 	| e1 e2 e3 |
+ 	"Evaluate aBlock with all edges making up triangles"
+ 	quadEdge timeStamp = timeStamp ifTrue:[^self].
+ 	quadEdge timeStamp: timeStamp.
+ 	e1 _ self.
+ 	e3 _ self originNext symmetric.
+ 	e2 _ e3 originNext symmetric.
+ 	(e2 timeStamp = timeStamp or:[e3 timeStamp = timeStamp])
+ 		ifFalse:[aBlock value: e1 value: e2 value: e3].
+ 	e1 _ self originPrev.
+ 	e3 _ self symmetric.
+ 	e2 _ e3 originNext symmetric.
+ 	(e1 timeStamp = timeStamp or:[e2 timeStamp = timeStamp])
+ 		ifFalse:[aBlock value: e1 value: e2 value: e3].
+ 	self originNext triangleEdges: timeStamp do: aBlock.
+ 	self originPrev triangleEdges: timeStamp do: aBlock.
+ 	self destNext triangleEdges: timeStamp do: aBlock.
+ 	self destPrev triangleEdges: timeStamp do: aBlock.!

Item was added:
+ Object subclass: #SubdivisionQuadEdge
+ 	instanceVariableNames: 'edges flags timeStamp'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Graphics-Tools-Triangulation'!
+ 
+ !SubdivisionQuadEdge commentStamp: '<historical>' prior: 0!
+ I represent a quad-edge within a subdivision.!

Item was added:
+ ----- Method: SubdivisionQuadEdge class>>new (in category 'instance creation') -----
+ new
+ 	^self basicNew initialize!

Item was added:
+ ----- Method: SubdivisionQuadEdge>>classificationColor (in category 'accessing') -----
+ classificationColor
+ 	"Return the classification index of the receiver"
+ 	| r g b |
+ 	r _ self isInteriorEdge ifTrue:[1] ifFalse:[0].
+ 	g _ self isExteriorEdge ifTrue:[1] ifFalse:[0].
+ 	b _ self isBorderEdge ifTrue:[1] ifFalse:[0].
+ 	^Color r: r g: g b: b.!

Item was added:
+ ----- Method: SubdivisionQuadEdge>>classificationIndex (in category 'accessing') -----
+ classificationIndex
+ 	"Return the classification index of the receiver"
+ 	^flags bitAnd: 7!

Item was added:
+ ----- Method: SubdivisionQuadEdge>>edgeClass (in category 'private') -----
+ edgeClass
+ 	^SubdivisionHalfEdge!

Item was added:
+ ----- Method: SubdivisionQuadEdge>>edges (in category 'accessing') -----
+ edges
+ 	^edges!

Item was added:
+ ----- Method: SubdivisionQuadEdge>>first (in category 'accessing') -----
+ first
+ 	^edges first!

Item was added:
+ ----- Method: SubdivisionQuadEdge>>flags (in category 'accessing') -----
+ flags
+ 	^flags!

Item was added:
+ ----- Method: SubdivisionQuadEdge>>flags: (in category 'accessing') -----
+ flags: newFlags
+ 	flags _ newFlags!

Item was added:
+ ----- Method: SubdivisionQuadEdge>>initialize (in category 'initialize-release') -----
+ initialize
+ 	edges := Array new: 4.
+ 	1 to: 4 do:[:i| edges at: i put: (self edgeClass new id: i owner: self)].
+ 	(edges at: 1) next: (edges at: 1).
+ 	(edges at: 2) next: (edges at: 4).
+ 	(edges at: 3) next: (edges at: 3).
+ 	(edges at: 4) next: (edges at: 2).
+ 	timeStamp := 0.
+ 	flags _ 0.!

Item was added:
+ ----- Method: SubdivisionQuadEdge>>isBorderEdge (in category 'accessing') -----
+ isBorderEdge
+ 	^flags anyMask: 1!

Item was added:
+ ----- Method: SubdivisionQuadEdge>>isBorderEdge: (in category 'accessing') -----
+ isBorderEdge: aBool
+ 	flags _ aBool ifTrue:[flags bitOr: 1] ifFalse:[flags bitClear: 1].!

Item was added:
+ ----- Method: SubdivisionQuadEdge>>isExteriorEdge (in category 'accessing') -----
+ isExteriorEdge
+ 	^flags anyMask: 4!

Item was added:
+ ----- Method: SubdivisionQuadEdge>>isExteriorEdge: (in category 'accessing') -----
+ isExteriorEdge: aBool
+ 	flags _ aBool ifTrue:[flags bitOr: 4] ifFalse:[flags bitClear: 4].!

Item was added:
+ ----- Method: SubdivisionQuadEdge>>isInteriorEdge (in category 'accessing') -----
+ isInteriorEdge
+ 	^flags anyMask: 2!

Item was added:
+ ----- Method: SubdivisionQuadEdge>>isInteriorEdge: (in category 'accessing') -----
+ isInteriorEdge: aBool
+ 	flags _ aBool ifTrue:[flags bitOr: 2] ifFalse:[flags bitClear: 2].!

Item was added:
+ ----- Method: SubdivisionQuadEdge>>timeStamp (in category 'accessing') -----
+ timeStamp
+ 	^timeStamp!

Item was added:
+ ----- Method: SubdivisionQuadEdge>>timeStamp: (in category 'accessing') -----
+ timeStamp: aNumber
+ 	timeStamp := aNumber!

Item was added:
+ Object subclass: #SugarBuddy
+ 	instanceVariableNames: 'key nick border fill ip'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sugar'!

Item was added:
+ ----- Method: SugarBuddy class>>fromDictionary: (in category 'instance creation') -----
+ fromDictionary: aDict
+ 	| buddyClass |
+ 	buddyClass := SugarBuddy.
+ 	(aDict at: 'owner' ifAbsent: []) == true
+ 		ifTrue: [
+ 			buddyClass := SugarBuddyOwner.
+ 			Utilities authorName: (aDict at: 'nick' ifAbsent: ['missing nick']) utf8ToSqueak composeAccents].
+ 
+ 	^buddyClass
+ 		key: (aDict at: 'key' ifAbsent: ['missing key'])
+ 		nick: (aDict at: 'nick' ifAbsent: ['missing nick']) utf8ToSqueak composeAccents
+ 		colors: (aDict at: 'color' ifAbsent: ['missing color']) 
+ 		ip: (aDict at: 'ip4-address' ifAbsent: ['missing address'])
+ !

Item was added:
+ ----- Method: SugarBuddy class>>fromMesh (in category 'instance creation') -----
+ fromMesh
+ 	| menu item |
+ 	menu := MenuMorph new.
+ 	(SugarLauncher current buddies asSortedCollection: [:a :b | a nick < b nick]) do: [:each |
+ 		each isOwner ifFalse: [
+ 		menu add: each nick target: each selector: #openBadge.
+ 		item := menu items last.
+ 		item icon: (each xoFormExtent: (item height + 5) asPoint background: menu color)]].
+ 	menu popUpInWorld
+ !

Item was added:
+ ----- Method: SugarBuddy class>>key:nick:border:fill:ip: (in category 'instance creation') -----
+ key: keyString nick: nickString border: borderColor fill: fillColor ip: ipString
+ 	"SugarBuddy key: '1234' nick: 'nick' border: Color green fill: Color yellow ip: '1.2.3.4'"
+ 	^self new setKey: keyString nick: nickString border: borderColor fill: fillColor ip: ipString!

Item was added:
+ ----- Method: SugarBuddy class>>key:nick:colors:ip: (in category 'instance creation') -----
+ key: keyString nick: nickString colors: colorString ip: ipString
+ 	"SugarBuddy key: '1234' nick: 'nick' colors: '#ff0000,#ffff00' ip: '1.2.3.4'"
+ 	| colors |
+ 	colors := (colorString findTokens: '#,') collect: [:c | Color fromString: c].
+ 	colors size = 2 ifFalse: [colors := {Color black. Color white}].
+ 	^self key: keyString nick: nickString border: colors first fill: colors second ip: ipString
+ !

Item was added:
+ ----- Method: SugarBuddy class>>owner (in category 'instance creation') -----
+ owner
+ 	^SugarLauncher current ownerBuddy!

Item was added:
+ ----- Method: SugarBuddy>>border (in category 'accessing') -----
+ border
+ 	^border
+ !

Item was added:
+ ----- Method: SugarBuddy>>colors (in category 'accessing') -----
+ colors
+ 	^border asHTMLColor, ',', fill asHTMLColor!

Item was added:
+ ----- Method: SugarBuddy>>fill (in category 'accessing') -----
+ fill
+ 	^fill!

Item was added:
+ ----- Method: SugarBuddy>>ip (in category 'accessing') -----
+ ip
+ 	^ip!

Item was added:
+ ----- Method: SugarBuddy>>isOwner (in category 'testing') -----
+ isOwner
+ 	^false!

Item was added:
+ ----- Method: SugarBuddy>>key (in category 'accessing') -----
+ key
+ 	^key!

Item was added:
+ ----- Method: SugarBuddy>>makeBadge (in category 'actions') -----
+ makeBadge
+ 	| badge font ext |
+ 	badge := EToySenderMorph new
+ 		userName: nick 
+ 		userPicture: (self xoFormExtent: 61 at 53 background: Color veryVeryLightGray) 
+ 		userEmail: 'who at where.net' 
+ 		userIPAddress: ip;
+ 		color: Color veryVeryLightGray;
+ 		borderColor: Color gray.
+ 	badge setProperty: #buddy toValue: self.
+ 	#( tellAFriend emailAddress  startTelemorphic "startAudioChat" startNebraskaClient ipAddress checkOnAFriend )
+ 		do: [:ea | badge hideField: ea].
+ 	font := Preferences standardEToysFont.
+ 	ext := (font widthOf: $m) + 2 @ font height.
+ 	badge allMorphsDo: [:m |
+ 		(m respondsTo: #font:) ifTrue: [m font: font].
+ 		(m class == SimpleButtonMorph) ifTrue: [m extent: ext]].
+ 	^ badge.!

Item was added:
+ ----- Method: SugarBuddy>>nick (in category 'accessing') -----
+ nick
+ 	^nick!

Item was added:
+ ----- Method: SugarBuddy>>openBadge (in category 'actions') -----
+ openBadge
+ 
+ 	^ self makeBadge openInHand.
+ !

Item was added:
+ ----- Method: SugarBuddy>>printOn: (in category 'printing') -----
+ printOn: aStream
+ 	aStream
+ 		print: self class;
+ 		nextPut: $(;
+ 		print: nick;
+ 		nextPut: $)!

Item was added:
+ ----- Method: SugarBuddy>>setKey:nick:border:fill:ip: (in category 'initialize-release') -----
+ setKey: keyString nick: nickString border: borderColor fill: fillColor ip: ipString
+ 
+ 	key := keyString.
+ 	nick := nickString.
+ 	border := borderColor.
+ 	fill := fillColor.
+ 	ip := ipString!

Item was added:
+ ----- Method: SugarBuddy>>xoFormExtent:background: (in category 'private') -----
+ xoFormExtent: aPoint background: aColor
+ 
+ 	| xo form |
+ 	form := Form extent: aPoint depth: 16.
+ 	form fillColor: aColor.
+ 	xo := OLPCSupport xoCharacterWithHeight: aPoint y insideColor: fill outsideColor: border.
+ 	form getCanvas translateBy: (aPoint // 2) - xo center during: [:c | c fullDrawMorph: xo].
+ 	^form
+ !

Item was added:
+ SugarBuddy subclass: #SugarBuddyOwner
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sugar'!

Item was added:
+ ----- Method: SugarBuddyOwner>>isOwner (in category 'testing') -----
+ isOwner
+ 	^true!

Item was added:
+ ThreePhaseButtonMorph subclass: #SugarButton
+ 	instanceVariableNames: 'mouseDownTime didMenu labelName highLightColor disabledImage'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sugar'!

Item was added:
+ ----- Method: SugarButton>>adaptToWorld: (in category 'initialization') -----
+ adaptToWorld: aWorld
+ 
+ 	super adaptToWorld: aWorld.
+ 	self state: #off.
+ !

Item was added:
+ ----- Method: SugarButton>>disabled (in category 'accessing') -----
+ disabled
+ 
+ 	self state: #disabled.
+ !

Item was added:
+ ----- Method: SugarButton>>disabledImage: (in category 'accessing') -----
+ disabledImage: aForm
+ 
+ 	disabledImage _ aForm.
+ !

Item was added:
+ ----- Method: SugarButton>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 
+ 	| origin |
+ 	image ifNil: [origin _ 0 at 0] ifNotNil: [origin _ bounds origin + ((bounds extent - image extent) // 2)].
+ 	state == #disabled ifTrue: [
+ 		aCanvas fillRectangle: self bounds fillStyle: color.
+ 		disabledImage ifNotNil: [^ aCanvas translucentImage: disabledImage at: origin]].
+ 	state == #off ifTrue: [
+ 		aCanvas fillRectangle: self bounds fillStyle: color. 
+ 		offImage ifNotNil: [^ aCanvas translucentImage: offImage at: origin]].
+ 	image ifNotNil: [
+ 		aCanvas fillRectangle: self bounds fillStyle: (highLightColor ifNil: [color]). 
+ 		aCanvas translucentImage: image at: origin].!

Item was added:
+ ----- Method: SugarButton>>enabled (in category 'accessing') -----
+ enabled
+ 
+ 	self state: #off.
+ !

Item was added:
+ ----- Method: SugarButton>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: evt
+ 
+ 	^ state ~~ #disabled.
+ !

Item was added:
+ ----- Method: SugarButton>>handlesMouseOver: (in category 'event handling') -----
+ handlesMouseOver: evt
+ 
+ 	^ state ~~ #disabled.
+ !

Item was added:
+ ----- Method: SugarButton>>handlesMouseStillDown: (in category 'event handling') -----
+ handlesMouseStillDown: evt
+ 
+ 	^ state ~~ #disabled.
+ !

Item was added:
+ ----- Method: SugarButton>>handlesMouseUp: (in category 'event handling') -----
+ handlesMouseUp: evt
+ 
+ 	^ state ~~ #disabled.
+ !

Item was added:
+ ----- Method: SugarButton>>highLightColor: (in category 'accessing') -----
+ highLightColor: aColor
+ 
+ 	highLightColor _ aColor.
+ !

Item was added:
+ ----- Method: SugarButton>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	super initialize.
+ 	highLightColor _ Color black.
+ 	self setProperty: #wantsHaloFromClick toValue: false.
+ !

Item was added:
+ ----- Method: SugarButton>>mouseDown: (in category 'event handling') -----
+ mouseDown: evt
+ 
+ 	super mouseDown: evt.
+ 	mouseDownTime _ Time millisecondClockValue.
+ 	didMenu _ nil.
+ !

Item was added:
+ ----- Method: SugarButton>>mouseEnter: (in category 'event handling') -----
+ mouseEnter: evt
+ 
+ 	self state: #over.
+ !

Item was added:
+ ----- Method: SugarButton>>mouseLeave: (in category 'event handling') -----
+ mouseLeave: evt
+ 
+ 	self state: #off.
+ !

Item was added:
+ ----- Method: SugarButton>>mouseStillDown: (in category 'event handling') -----
+ mouseStillDown: evt
+ 
+ 	(mouseDownTime isNil or: [(Time millisecondClockValue - mouseDownTime) abs < 1000]) ifTrue: [
+ 		^super mouseStillDown: evt
+ 	].
+ 	didMenu ifNotNil: [^super mouseStillDown: evt].
+ 	didMenu _ target showMenuFor: actionSelector event: evt.
+ !

Item was added:
+ ----- Method: SugarButton>>mouseUp: (in category 'event handling') -----
+ mouseUp: evt
+ 
+ 	super mouseUp: evt.
+ 	self state: #off.
+ !

Item was added:
+ ----- Method: SugarButton>>naviHeight: (in category 'geometry') -----
+ naviHeight: anInteger
+ 
+ 	| imageSize |
+ 	imageSize _ image
+ 		ifNotNil: [(anInteger * (image height asFloat / self height)) asInteger]
+ 		ifNil: [(anInteger * 0.6) asInteger].
+ 	imageSize _ imageSize at imageSize.
+ 
+ 	image ifNotNil: [image _ image scaledToSize: imageSize].
+ 	offImage ifNotNil: [offImage _ offImage scaledToSize: imageSize].
+ 	pressedImage ifNotNil: [pressedImage _ pressedImage scaledToSize: imageSize].
+ 	disabledImage ifNotNil: [disabledImage _ disabledImage scaledToSize: imageSize].
+ 	super extent: anInteger at anInteger.
+ !

Item was added:
+ Object subclass: #SugarDatastoreDirectory
+ 	instanceVariableNames: 'query extension'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sugar'!

Item was added:
+ ----- Method: SugarDatastoreDirectory class>>mimetype:extension: (in category 'instance creation') -----
+ mimetype: mimeString extension: extString
+ 	^self new
+ 		query: ({'mime_type' -> mimeString} as: Dictionary);
+ 		extension: extString!

Item was added:
+ ----- Method: SugarDatastoreDirectory class>>query: (in category 'instance creation') -----
+ query: aDictionaryOrString
+ 	^self new query: aDictionaryOrString!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>acceptsUploads (in category 'testing') -----
+ acceptsUploads
+ 	"answer whatever the receiver accepts uploads"
+ 	^ true!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>assureExistence (in category 'file directory') -----
+ assureExistence
+ 	"Make sure the current directory exists. If necessary, create all parts inbetween"
+ 	!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>createDirectory: (in category 'file directory') -----
+ createDirectory: localName 
+ 	"Create a new sub directory within the current one"
+ 	^ self inform: 'operation not supported' translated!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>deleteDirectory: (in category 'file directory') -----
+ deleteDirectory: localName
+ 	"Delete the sub directory within the current one.  Call needs to ask user to confirm."
+ 	^ self inform: 'operation not supported' translated!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>deleteFileNamed: (in category 'file directory') -----
+ deleteFileNamed: localFileName 
+ 	"Delete the file with the given name in this directory."
+ 	^ self inform: 'Use the journal to delete entries' translated!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>directories (in category 'accessing') -----
+ directories
+ 	"No hierarchies in datastore - otherwise the path parts"
+ 	^#()!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>directory (in category 'accessing') -----
+ directory
+ 	"No hierarchies in datastore"
+ 	^''!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>directoryNamed: (in category 'file directory') -----
+ directoryNamed: aString 
+ 	"Return the subdirectory of this directory with the given name."
+ 	^ self halt!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>directoryNames (in category 'file directory') -----
+ directoryNames
+ 	"Return a collection of names for the subdirectories of this directory. "
+ 	^ #()!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>directoryWrapperClass (in category 'accessing') -----
+ directoryWrapperClass
+ 	"answer the class to be used as a wrapper in FileList2"
+ 	^ FileDirectoryWrapper!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>downloadUrl (in category 'accessing') -----
+ downloadUrl
+ 	"The url under which files will be accessible - ending in a slash"
+ 	^'sugar:///'!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>entries (in category 'file directory') -----
+ entries
+ 	"Return a collection of directory entries for the files and 
+ 	directories in this directory."
+ 
+ 	^(SugarLauncher current
+ 		findJournalEntries: self query properties: #('uid' 'title' 'ctime' 'mtime' 'file-size'))
+ 		collect: [:props |
+ 			props keysAndValuesDo: [:key :value | props at: key put: value asString].
+ 			DirectoryEntry
+ 				name: (((props at: 'title') copyReplaceAll: '/' with: '\') contractTo: 64) utf8ToSqueak, '-', (props at: 'uid'), self extension
+ 				creationTime: ([(DateAndTime fromString: (props at: 'ctime')) asSeconds] ifError: [0])
+ 				modificationTime: ([(DateAndTime fromString: (props at: 'mtime')) asSeconds] ifError: [0])
+ 				isDirectory: false
+ 				fileSize: (props at: 'file-size' ifAbsent: [42])
+ 		]!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>exists (in category 'file directory') -----
+ exists
+ 	^SugarLauncher isRunningInSugar!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>extension (in category 'accessing') -----
+ extension
+ 	^extension ifNil: ['']!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>extension: (in category 'accessing') -----
+ extension: aString
+ 	extension := aString!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>fileAndDirectoryNames (in category 'file directory') -----
+ fileAndDirectoryNames
+ 	"Return a collection of names for all files and directories in this directory."
+ 	^ self entries collect: [:entry | entry name]!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>fileExists: (in category 'file directory') -----
+ fileExists: fileName
+ 	^ self fileNames includes: fileName!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>fileNames (in category 'file directory') -----
+ fileNames
+ 	"Return a collection of names for the files (but not directories) in this directory."
+ 	^ self entries collect: [:entry | entry name]!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>fullNameFor: (in category 'file directory') -----
+ fullNameFor: aString
+ 	^aString!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>groupName (in category 'accessing') -----
+ groupName
+ 
+ 	^self moniker!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>hasEToyUserList (in category 'testing') -----
+ hasEToyUserList
+ 	^false!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>includesKey: (in category 'file directory') -----
+ includesKey: localName
+ 	"Answer true if this directory includes a file or directory of the given name. Note that the name should be a local file name, in contrast with fileExists:, which takes either local or full-qualified file names."
+ 
+ 	^ self fileAndDirectoryNames includes: localName
+ !

Item was added:
+ ----- Method: SugarDatastoreDirectory>>isProjectSwiki (in category 'testing') -----
+ isProjectSwiki
+ 	"answer whatever the receiver is a project swiki"
+ 	^ true!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>isRemoteDirectory (in category 'testing') -----
+ isRemoteDirectory
+ 	"answer whatever the receiver is a remote directory"
+ 	^ false!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>isSearchable (in category 'testing') -----
+ isSearchable
+ 	"answer whatever the receiver is searchable super-swiki"
+ 	^false!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>moniker (in category 'accessing') -----
+ moniker
+ 	"a plain language name for this directory"
+ 	^ 'Journal' translated!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>newFileNamed: (in category 'file directory') -----
+ newFileNamed: localName 
+ 	^ self notYetImplemented !

Item was added:
+ ----- Method: SugarDatastoreDirectory>>oldFileNamed: (in category 'file directory') -----
+ oldFileNamed: aName
+ 	^ self readOnlyFileNamed: aName!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>oldFileOrNoneNamed: (in category 'file directory') -----
+ oldFileOrNoneNamed: aName
+ 	^ self readOnlyFileNamed: aName!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>pathName (in category 'accessing') -----
+ pathName
+ 	^self downloadUrl!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>pathParts (in category 'accessing') -----
+ pathParts
+ 	"No hierarchies in datastore"
+ 	^#()!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>query (in category 'accessing') -----
+ query
+ 	^query ifNil: ['']!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>query: (in category 'accessing') -----
+ query: aDictionaryOrString
+ 	query := aDictionaryOrString!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>readOnlyFileNamed: (in category 'file directory') -----
+ readOnlyFileNamed: aName 
+ 	"aName contains the object id as last 36 chars before the extension"
+ 	| id |
+ 	id := (aName allButLast: self extension size) last: 36.
+ 	^SugarLauncher current getFile: id.
+ !

Item was added:
+ ----- Method: SugarDatastoreDirectory>>realUrl (in category 'accessing') -----
+ realUrl
+ 	"a fully expanded version of the url we represent, but without final slash"
+ 	^ String streamContents: [:stream |
+ 			stream nextPutAll: 'sugar:///'.
+ 			query ifNotNil: [
+ 				stream nextPutAll: '?'.
+ 				query isString
+ 					ifTrue: [stream nextPutAll: query encodeForHTTP]
+ 					ifFalse: [query associations asSortedCollection
+ 						do: [:each | stream
+ 							nextPutAll: each key encodeForHTTP;
+ 							nextPut: $=;
+ 							nextPutAll: each value encodeForHTTP]
+ 						separatedBy: [stream nextPut: $&]]]]!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>rename:toBe: (in category 'file directory') -----
+ rename: fullName toBe: newName 
+ 	"Rename a remote file. fullName is just be a fileName, or can 
+ 	be directory path that includes name of the server. newName 
+ 	is just a fileName"
+ 	^ self inform: 'operation not supported' translated!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>reset (in category 'file directory') -----
+ reset!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>sleep (in category 'file directory') -----
+ sleep
+ 	"Leave the FileList window."
+ 	^ self!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>wakeUp (in category 'file directory') -----
+ wakeUp
+ 	"Entering a FileList window"
+ 	^ self!

Item was added:
+ ----- Method: SugarDatastoreDirectory>>writeProject:inFileNamed:fromDirectory: (in category 'projects') -----
+ writeProject: aProject inFileNamed: fileNameString fromDirectory: localDirectory 
+ 	"write aProject (a file version can be found in the file named fileNameString in localDirectory)"
+ 
+ 	SugarLauncher current
+ 		makeJournalEntryFor: aProject
+ 		filename: (localDirectory fullNameFor: fileNameString)
+ 		mimetype: 'application/x-squeak-project'.
+ 	^true!

Item was added:
+ AbstractLauncher subclass: #SugarLauncher
+ 	instanceVariableNames: 'sharedActivity buddies buddiesLock tubes tubesLock'
+ 	classVariableNames: 'Current UISema'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sugar'!
+ 
+ !SugarLauncher commentStamp: '<historical>' prior: 0!
+ SugarLauncher handles communication with Sugar in the OLPC environment.
+ 
+ The DBus communication is used for, e.g., storing to the Journal (datastore), and networking (presence).
+ 
+ We also handle events from the window system.
+ 
+ !

Item was added:
+ ----- Method: SugarLauncher class>>current (in category 'accessing') -----
+ current
+ 	^Current ifNil: [Current := self new]!

Item was added:
+ ----- Method: SugarLauncher class>>defaultDatastoreDirName (in category 'utilities') -----
+ defaultDatastoreDirName
+ 
+ 	^ '[Journal]'
+ !

Item was added:
+ ----- Method: SugarLauncher class>>fileReaderServicesForFile:suffix: (in category 'services') -----
+ fileReaderServicesForFile: fullName suffix: suffix
+ 
+ 	^({ 'pr'. 'st'. 'cs'. '*' } includes: suffix)
+ 		ifTrue: [self services]
+ 		ifFalse: [#()]!

Item was added:
+ ----- Method: SugarLauncher class>>initialize (in category 'services') -----
+ initialize
+ 	Preferences
+ 		addPreference: #sugarAutoSave
+ 		category:  #morphic
+ 		default: false
+ 		balloonHelp: 'If enabled, quitting under Sugar will automatically save the current project.'.
+ !

Item was added:
+ ----- Method: SugarLauncher class>>isRunningInRainbow (in category 'testing') -----
+ isRunningInRainbow
+ 	^self current isRunningInRainbow!

Item was added:
+ ----- Method: SugarLauncher class>>isRunningInSugar (in category 'testing') -----
+ isRunningInSugar
+ 	^self current isRunningInSugar!

Item was added:
+ ----- Method: SugarLauncher class>>serviceWrapAsXOBundle (in category 'services') -----
+ serviceWrapAsXOBundle
+ 	"Answer a service for wrapping a file as an .xo bundle"
+ 
+ 	^ FileModifyingSimpleServiceEntry 
+ 		provider: self 
+ 		label: 'make XO bundle' translatedNoop
+ 		selector: #wrapAsXOBundle:
+ 		description: 'wrap as an OLPC XO bundle' translatedNoop
+ 		buttonLabel: 'XO'!

Item was added:
+ ----- Method: SugarLauncher class>>services (in category 'services') -----
+ services
+ 	^ {self serviceWrapAsXOBundle}!

Item was added:
+ ----- Method: SugarLauncher class>>shutDown (in category 'class initialization') -----
+ shutDown
+ 	Current ifNotNil: [Current shutDown. Current := nil]!

Item was added:
+ ----- Method: SugarLauncher class>>welcomeProjectName (in category 'accessing') -----
+ welcomeProjectName
+ 	"Deprecated"
+ 	^Project home ifNotNilDo: [:p | p name]!

Item was added:
+ ----- Method: SugarLauncher class>>wrapAsXOBundle: (in category 'services') -----
+ wrapAsXOBundle: aFileName 
+ 	Utilities
+ 		informUser: 'Making bundle' translated
+ 		during: [Cursor wait showWhile:
+ 			[self current bundle: aFileName]]!

Item was added:
+ ----- Method: SugarLauncher>>active: (in category 'commands') -----
+ active: aBoolean
+ 	"Etoys activity received or lost focus"
+ 
+ 	Preferences setPreference: #soundsEnabled toValue: aBoolean.
+ 	aBoolean
+ 		ifTrue: [
+ 			UISema ifNotNilDo: [:s | s signal].
+ 		] 
+ 		ifFalse: [
+ 			SoundPlayer shutDown.
+ 			SoundRecorder anyActive ifTrue: [SoundRecorder allSubInstancesDo: [:r | r stopRecording]].
+ 			VideoDevice shutDown: true.
+ 
+ 			UISema ifNil: [UISema := Semaphore new].
+ 			UISema initSignals.
+ 			WorldState addDeferredUIMessage: [UISema wait].
+ 		].
+ !

Item was added:
+ ----- Method: SugarLauncher>>activityId (in category 'accessing') -----
+ activityId
+ 	^parameters at: 'ACTIVITY_ID'!

Item was added:
+ ----- Method: SugarLauncher>>badgeFlap (in category 'presence') -----
+ badgeFlap
+ 	"This finds or creates a flap to hold badges"
+ 
+ 	| translatedFlapName flapTab flap spacer holder |
+ 	translatedFlapName := 'Buddies' translated.
+ 	flapTab := Flaps globalFlapTab: translatedFlapName.
+ 	flapTab ifNotNil: [^flapTab].
+ 
+ 	flap := AlignmentMorph newRow.
+ 	flap clipSubmorphs: true.
+ 	flap beTransparent.
+ 	flap layoutInset: 0; cellInset: 0; borderWidth: 0.
+ 	flap setProperty: #wantsHaloFromClick toValue: false.
+ 	flap beFlap: true.
+ 
+ 	spacer := Morph new beTransparent.  "This provides space for tabs to be seen."
+ 	spacer width:  20.
+ 	spacer hResizing: #rigid; vResizing: #spaceFill.
+ 	flap addMorphBack: spacer. 
+ 
+ 	holder := Morph new.
+ 	holder name: 'Badges'.
+ 	holder position: 0 at 100.
+ 	holder layoutPolicy: TableLayout new.
+ 	holder color: Color red muchLighter;
+ 		wrapDirection: #topToBottom;
+ 		hResizing: #spaceFill;
+ 		vResizing: #spaceFill;
+ 		cellInset: 10;
+ 		layoutInset: 10.
+ 	flap addMorphBack: holder.
+ 
+ 	flap beSticky.
+ 	spacer beSticky; lock: true.
+ 	holder beSticky.
+ 
+ 	flapTab := FlapTab new.
+ 	flapTab referent: flap.
+ 	flapTab setName: translatedFlapName edge: #left color: Color red muchLighter.
+ 	flapTab referentMargin: 0 at 75.
+ 	flapTab setToPopOutOnDragOver:  true.
+ 	Flaps addGlobalFlap: flapTab.
+ 	ActiveWorld addGlobalFlaps.
+ 	ScriptingSystem cleanUpFlapTabsOnLeft.
+ 
+ 	^flapTab!

Item was added:
+ ----- Method: SugarLauncher>>badgeFor: (in category 'presence') -----
+ badgeFor: aBuddy
+ 	^self badgeHolder submorphs
+ 		detect: [:m |
+ 			(m isKindOf: EToySenderMorph) and: [
+ 				(m valueOfProperty: #buddy) = aBuddy]]
+ 		ifNone: [nil]
+ !

Item was added:
+ ----- Method: SugarLauncher>>badgeHolder (in category 'presence') -----
+ badgeHolder
+ 	"This finds or creates a flap to hold badges"
+ 
+ 	^self badgeFlap referent submorphNamed: 'Badges'
+ !

Item was added:
+ ----- Method: SugarLauncher>>buddies (in category 'presence') -----
+ buddies
+ 	sharedActivity ifNil: [^Dictionary new].
+ 	buddies ifNil: [self setupBuddies].
+ 	^buddies!

Item was added:
+ ----- Method: SugarLauncher>>buddiesLock (in category 'presence') -----
+ buddiesLock
+ 	^buddiesLock ifNil: [buddiesLock := Semaphore forMutualExclusion]!

Item was added:
+ ----- Method: SugarLauncher>>buddyJoined: (in category 'presence') -----
+ buddyJoined: buddyProxy
+ 	"possibly sent via DBus in background process"
+ 	| properties key buddy |
+ 	properties := [buddyProxy getProperties] on: DBusError do: [^self].
+ 	(properties at: #owner ifAbsent: [false]) == true ifTrue: [^self].
+ 	key := properties at: #key ifAbsent: [^self].
+ 	self buddiesLock critical: [
+ 		buddies ifNil: [^self].
+ 		(buddies includesKey: key) ifTrue: [^self].
+ 		buddy := SugarBuddy fromDictionary: properties.
+ 		buddies at: key put: buddy].
+ 	WorldState addDeferredUIMessage: [
+ 		self badgeHolder addMorphBack: buddy makeBadge.
+ 		self showBadges]!

Item was added:
+ ----- Method: SugarLauncher>>buddyLeft: (in category 'presence') -----
+ buddyLeft: buddyProxy
+ 	"sent via DBus in background process"
+ 	| properties key buddy badge |
+ 	properties := [buddyProxy getProperties] on: DBusError do: [^self].
+ 	key := properties at: #key ifAbsent: [^self].
+ 	buddy := self buddiesLock critical: [
+ 		buddies ifNil: [^self].
+ 		buddies removeKey: key ifAbsent: [^self]].
+ 	WorldState addDeferredUIMessage: [
+ 		badge := self badgeFor: buddy.
+ 		badge ifNotNil: [badge delete]].!

Item was added:
+ ----- Method: SugarLauncher>>bundle: (in category 'bundling') -----
+ bundle: aFileName
+ 	| localName nameAndVersion cleanName |
+ 	localName := (FileDirectory localNameFor: aFileName) copyUpToLast: $..
+ 	nameAndVersion := localName stemAndNumericSuffix.
+ 	cleanName := nameAndVersion first select: [:c | c isAlphaNumeric].
+ 	^self
+ 		bundle: aFileName
+ 		as: cleanName
+ 		title: nameAndVersion first
+ 		version: (nameAndVersion second max: 1)
+ 		id: 'org.squeak.', cleanName
+ 		icon: self bundleIcon
+ !

Item was added:
+ ----- Method: SugarLauncher>>bundle:as:title:version:id:icon: (in category 'bundling') -----
+ bundle: aFileName as: aBundleName title: aTitle version: aVersion id: aBundleID icon: anSVGIcon
+ 	"Create a ZIP file named aBundleName-aVersion.xo containing
+ 		aBundleName.activity/
+ 			aFileName
+ 			bin/etoys-launch
+ 			activity/activity.info
+ 			activity/aBundleName-icon.svg
+ 			locale/...
+ 	"
+ 	| dir archive fileAttr execAttr dirAttr localFileName scriptName |
+ 	fileAttr := 16r81A4.
+ 	execAttr := 16r81ED.
+ 	dirAttr := 16r41ED.
+ 	dir := aBundleName, '.activity/'.
+ 	localFileName := FileDirectory localNameFor: aFileName.
+ 	scriptName := aBundleName, '.sh'.
+ 	archive := ZipArchive new.
+ 	#('' 'bin' 'activity' 'locale') do: [:dirName | 
+ 		(archive addDirectory: dir, dirName) unixFileAttributes: dirAttr].
+ 	(archive addFile: aFileName as: dir, localFileName) unixFileAttributes: fileAttr.
+ 	(archive addString: (self bundleScript: localFileName) as: dir, 'bin/', scriptName) unixFileAttributes: execAttr.
+ 	(archive addString: (self bundleInfoTitle: aTitle version: aVersion bundle: aBundleID script: scriptName icon: aBundleName, '-icon') as: dir, 'activity/activity.info') unixFileAttributes: fileAttr.
+ 	(archive addString: self bundleIcon as: dir, 'activity/', aBundleName, '-icon.svg') unixFileAttributes: fileAttr.
+ 	archive members do: [:m | m setLastModFileDateTimeFrom: Time totalSeconds].
+ 	archive writeToFileNamed: aBundleName, '-', aVersion asString, '.xo'.
+ 	archive close.!

Item was added:
+ ----- Method: SugarLauncher>>bundleIcon (in category 'bundling') -----
+ bundleIcon
+ 	^self bundleIconTemplate  replaceAll: Character cr with: Character lf!

Item was added:
+ ----- Method: SugarLauncher>>bundleIconTemplate (in category 'bundling') -----
+ bundleIconTemplate
+ 	"template for activity/icon.svg"
+ 
+ 	^'<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+ <!!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd" [
+         <!!ENTITY fill_color "#AAAAAA">
+         <!!ENTITY stroke_color "#000000">
+ ]>
+ <svg xmlns="http://www.w3.org/2000/svg" width="55" height="55">
+   <g>
+     <rect width="45" height="45" x="5" y="5" ry="7.5"
+        style="fill:&fill_color;;stroke:&stroke_color;;stroke-width:3" />
+   </g>
+ </svg>
+ '!

Item was added:
+ ----- Method: SugarLauncher>>bundleId (in category 'accessing') -----
+ bundleId
+ 	^parameters at: 'BUNDLE_ID' ifAbsent: ['org.squeak']!

Item was added:
+ ----- Method: SugarLauncher>>bundleInfoTemplate (in category 'bundling') -----
+ bundleInfoTemplate
+ 	"template for activity/activity.info"
+ 
+ 	^'[Activity]
+ name = {TITLE}
+ activity_version = {VERSION}
+ host_version = 1
+ bundle_id = {BUNDLE}
+ icon = {ICON}
+ exec = {SCRIPT}
+ show_launcher = yes
+ '!

Item was added:
+ ----- Method: SugarLauncher>>bundleInfoTitle:version:bundle:script:icon: (in category 'bundling') -----
+ bundleInfoTitle: aTitle version: aVersion bundle: aBundle script: aScriptName icon: anIconName 
+ 	| s |
+ 	s := self bundleInfoTemplate.
+ 	{	'{TITLE}'. aTitle.
+ 		'{VERSION}'. aVersion asString.
+ 		'{BUNDLE}'. aBundle.
+ 		'{ICON}'. anIconName.
+ 		'{SCRIPT}'. aScriptName.
+ 		String cr. String lf.
+ 	} pairsDo: [:key :val |
+ 		s := s copyReplaceAll:  key with: val].
+ 	^s squeakToUtf8!

Item was added:
+ ----- Method: SugarLauncher>>bundlePath (in category 'accessing') -----
+ bundlePath
+ 	^parameters at: 'BUNDLE_PATH' ifAbsent: [FileDirectory default pathName]!

Item was added:
+ ----- Method: SugarLauncher>>bundleScript: (in category 'as yet unclassified') -----
+ bundleScript: aFileName
+ 	| s |
+ 	s := self bundleScriptTemplate.
+ 	{	'{FILE}'. aFileName.
+ 		String cr. String lf.
+ 	} pairsDo: [:key :val |
+ 		s := s copyReplaceAll:  key with: val].
+ 	^s squeakToUtf8 !

Item was added:
+ ----- Method: SugarLauncher>>bundleScriptTemplate (in category 'bundling') -----
+ bundleScriptTemplate
+ 	"template for MyActivity.activity/bin/MyActivity.sh"
+ 
+ 	^'#!!/bin/sh
+ # Author: Bert Freudenberg
+ # Purpose: Run {FILE} in Etoys
+ 
+ # arguments are unordered, have to loop
+ args=""
+ while [ -n "$2" ] ; do
+     case "$1" in
+       	-b | --bundle-id)   bundle_id="$2"   ; args="$args BUNDLE_ID $2" ;;
+       	-a | --activity-id) activity_id="$2" ; args="$args ACTIVITY_ID $2";;
+       	-o | --object-id)   object_id="$2"   ; args="$args OBJECT_ID $2";;
+ 	-u | --uri)         uri="$2"         ; args="$args URI $2";;
+ 	*) echo unknown argument $1 $2 ;;
+     esac
+     shift;shift
+ done
+ 
+ # really need bundle id and activity id
+ if [ -z "$bundle_id" -o -z "$activity_id" ] ; then
+   echo ERROR: bundle-id and activity-id arguments required
+   echo Aborting
+   exit 1
+ fi
+ 
+ # some debug output
+ echo launching $bundle_id instance $activity_id
+ [ -n "$object_id"   ] && echo with journal obj $object_id
+ [ -n "$uri"         ] && echo loading uri $uri
+ echo
+ 
+ # sanitize
+ [ -z "$SUGAR_PROFILE" ] && SUGAR_PROFILE=default
+ [ -z "$SUGAR_ACTIVITY_ROOT" ] && SUGAR_ACTIVITY_ROOT="$HOME/.sugar/$SUGAR_PROFILE/etoys"
+ 
+ # rainbow-enforced locations
+ export SQUEAK_SECUREDIR="$SUGAR_ACTIVITY_ROOT/data/private"
+ export SQUEAK_USERDIR="$SUGAR_ACTIVITY_ROOT/data/MyEtoys"
+ 
+ # make group-writable for rainbow
+ umask 0002
+ [ !! -d "$SQUEAK_SECUREDIR" ] && mkdir -p "$SQUEAK_SECUREDIR" && chmod o-rwx "$SQUEAK_SECUREDIR"
+ [ !! -d "$SQUEAK_USERDIR" ] && mkdir -p "$SQUEAK_USERDIR"
+ 
+ # do not crash on dbus errors
+ export DBUS_FATAL_WARNINGS=0
+ 
+ # now run Squeak VM with Etoys image
+ exec etoys \
+     -sugarBundleId $bundle_id \
+     -sugarActivityId $activity_id \
+     --document "{FILE}" \
+     BUNDLE_PATH "$SUGAR_BUNDLE_PATH" \
+     MO_PATH "$SUGAR_BUNDLE_PATH/locale" \
+     $args
+ '!

Item was added:
+ ----- Method: SugarLauncher>>chooseObject (in category 'chooser') -----
+ chooseObject
+ 	| chooserId |
+ 	chooserId := self journal chooseObject: 0.
+ 	self journal
+ 		onObjectChooserResponse: chooserId send: #chooser:response: to: self;
+ 		onObjectChooserCancelled: chooserId send: #chooserDone: to: self!

Item was added:
+ ----- Method: SugarLauncher>>chooser:response: (in category 'chooser') -----
+ chooser: chooserId response: objectIdOrPath
+ 	self chooserDone: chooserId.
+ 	WorldState addDeferredUIMessage: [
+ 		(objectIdOrPath beginsWith: '/')
+ 			ifTrue: [
+ 				| path file title |
+ 				path := objectIdOrPath utf8ToSqueak.
+ 				file := FileStream readOnlyFileNamed: path.
+ 				title := FileDirectory localNameFor: path.
+ 				self handleStream: file mimetype: nil titled: title]
+ 			ifFalse: [
+ 				| props title mimetype |
+ 				props := self getProperties: objectIdOrPath.
+ 				title := props at: 'title' ifAbsent: ['untitled' translated].
+ 				mimetype := props at: 'mime_type' ifAbsent: [''].
+ 				[self open: objectIdOrPath title: title mimetype: mimetype]
+ 					on: SugarPropertiesNotification do: [:ex | ex resume: props]]].!

Item was added:
+ ----- Method: SugarLauncher>>chooserDone: (in category 'chooser') -----
+ chooserDone: chooserId
+ 	self journal
+ 		onObjectChooserResponse: chooserId send: nil to: self;
+ 		onObjectChooserCancelled: chooserId send: nil to: self!

Item was added:
+ ----- Method: SugarLauncher>>createJournalEntryFor:filename:mimetype: (in category 'datastore') -----
+ createJournalEntryFor: aProject filename: aFilename mimetype: mimetypeString
+ 	| properties id |
+ 	properties := self propertiesFrom: aProject.
+ 	properties at: 'ctime' put: (properties at: 'mtime').
+ 	properties at: 'mime_type' put: mimetypeString.
+ 	properties removeKey: 'uid' ifAbsent: [].		"would confuse Sugar 0.82"
+ 	aFilename ifEmpty: [properties at: 'title:text' put: 'Etoys' translated].
+ 	id := self dataStore create: properties with: aFilename squeakToUtf8 with: true.
+ 	^id asString!

Item was added:
+ ----- Method: SugarLauncher>>dataStore (in category 'accessing') -----
+ dataStore
+ 	^DBus sessionBus get: SugarDataStore!

Item was added:
+ ----- Method: SugarLauncher>>deleteBadges (in category 'presence') -----
+ deleteBadges
+ 	| flapTab |
+ 	flapTab := (Flaps globalFlapTab: 'Buddies' translated) ifNil: [^self].
+ 	Flaps removeFlapTab: flapTab keepInList: false.
+ !

Item was added:
+ ----- Method: SugarLauncher>>deleteUnused: (in category 'datastore') -----
+ deleteUnused: filePath
+ 	"Delete file if filePath is indeed unused"
+ 
+ 	World submorphs do: [:m | 
+ 		(m isSystemWindow and: [
+ 			(m model isKindOf: FileList) and: [
+ 				m model fullName = filePath]]) ifTrue: [
+ 					^self deleteUnused: filePath whenDoneWith: m]].
+ 
+ 	[FileDirectory deleteFilePath: filePath] on: Error do: ["ignore"]
+ !

Item was added:
+ ----- Method: SugarLauncher>>deleteUnused:whenDoneWith: (in category 'datastore') -----
+ deleteUnused: fileName whenDoneWith: anObject
+ 	"Delete fileName when anObject is not in use anymore"
+ 
+ 	^anObject
+ 		toFinalizeSend: #deleteUnused: 
+ 		to: self
+ 		with: fileName!

Item was added:
+ ----- Method: SugarLauncher>>enableSharedActivitySignals (in category 'presence') -----
+ enableSharedActivitySignals
+ 	sharedActivity onBuddyJoinedSend: #buddyJoined: to: self.
+ 	sharedActivity onBuddyLeftSend: #buddyLeft: to: self.
+ !

Item was added:
+ ----- Method: SugarLauncher>>findJournalEntries:properties: (in category 'datastore') -----
+ findJournalEntries: query properties: propNames
+ 	"query is either a String or a dictionary, e.g. {'mime_type'->'application/x-squeak-project'}. Answers an array of properties. If propNames is not nil, only the named properties will be returned (which will be more efficient)"
+ 	^(self dataStore find: query with: (propNames ifNil: [#()])) first!

Item was added:
+ ----- Method: SugarLauncher>>gconfPropertiesAt: (in category 'gconf') -----
+ gconfPropertiesAt: aString
+ 	| dir |
+ 	"search up tree to guess home dir"
+ 	dir := Project squeakletDirectory.
+ 	[dir pathName = '/'] whileFalse: [
+ 		dir := dir containingDirectory.		
+ 		[FileStream
+ 			readOnlyFileNamed: dir pathName, '/.gconf', aString, '/%gconf.xml'
+ 			do: [:f |
+ 				| props |
+ 				props := Dictionary new.
+ 				(XMLDOMParser parseDocumentFrom: f)
+ 					tagsNamed: #entry do: [:entry |
+ 						props at: (entry attributeAt: 'name')
+ 							put: (entry attributeAt: 'value'
+ 								ifAbsent: [entry elements first contentString])].
+ 				^props].
+ 		] on: FileDoesNotExistException do: [:ignore | ].
+ 	].
+ 	^self error: 'cannot find gconf path ', aString!

Item was added:
+ ----- Method: SugarLauncher>>getChannels (in category 'telepathy') -----
+ getChannels
+ 	^[:tpService :tpConn :tpChannels |
+ 		tpChannels collect: [:channel |
+ 			TelepathyChannel
+ 				connection: tpConn dbusConnection
+ 				busName: tpService
+ 				objectPath: channel dbusPath]
+ 	] valueWithArguments: sharedActivity getChannels!

Item was added:
+ ----- Method: SugarLauncher>>getFile: (in category 'datastore') -----
+ getFile: id
+ 	"answer a temporary file, will be deleted if not used anymore"
+ 	| utf8Name file |
+ 	utf8Name := self dataStore getFilename: id.
+ 	utf8Name isEmptyOrNil ifTrue: [^nil].
+ 	file := FileStream readOnlyFileNamed: utf8Name utf8ToSqueak.
+ 	self deleteUnused: file name whenDoneWith: file.
+ 	^file!

Item was added:
+ ----- Method: SugarLauncher>>getProperties: (in category 'datastore') -----
+ getProperties: objectId
+ 	| props |
+ 	props := self dataStore getProperties: objectId.
+ 	"Make sure the props we care about are strings"
+ 	props at: 'title' ifPresent: [:value | props at: 'title' put: value asString utf8ToSqueak composeAccents].
+ 	props at: 'mime_type' ifPresent: [:value | props at: 'mime_type' put: value asString].
+ 	props at: 'uid' put: objectId asString.
+ 	^props!

Item was added:
+ ----- Method: SugarLauncher>>getTubesChannel (in category 'telepathy') -----
+ getTubesChannel
+ 	^self getChannels detect: [:channel |
+ 		channel getChannelType = 'org.freedesktop.Telepathy.Channel.Type.Tubes']!

Item was added:
+ ----- Method: SugarLauncher>>handleStream:mimetype:titled: (in category 'datastore') -----
+ handleStream: tmpStream mimetype: mimetypeOrNil titled: title
+ 	"tmpStream was opened from journal or other media.
+ 	For simplicity, we re-use the file drop logic."
+ 
+ 	ActiveHand lastEvent position: World center.
+ 	[
+ 		[(ExternalDropHandler lookupExternalDropHandler: tmpStream)
+ 			handle: tmpStream in: World dropEvent: ActiveHand lastEvent]
+ 		ifError: [self inform: ('Cannot open {1}' translated format: {title})]
+ 	] ensure: [tmpStream ifNotNil: [tmpStream close]].!

Item was added:
+ ----- Method: SugarLauncher>>invite: (in category 'commands') -----
+ invite: aBuddyKey
+ 	"aBuddy was invited to our activity."
+ 
+ 	| buddy |
+ 	Utilities informUser: 'Inviting buddy ...' translated
+ 		during: [
+ 			self isShared ifFalse: [
+ 				self sharePublicly: false.
+ 				SugarNavigatorBar current joinSharedActivity].
+ 			buddy := self presence getBuddyByPublicKey: aBuddyKey asByteArray.
+ 			sharedActivity invite: buddy with: ''].
+ !

Item was added:
+ ----- Method: SugarLauncher>>isRunningInRainbow (in category 'testing') -----
+ isRunningInRainbow
+ 	"Need better test, but works for now. We cannot use dbus here"
+ 	^Smalltalk osVersion = 'linux-gnu'
+ 		and: [#('/home/olpc/isolation/' '/activities/' ) anySatisfy: [:dir |
+ 			SecurityManager default secureUserDirectory beginsWith: dir]]!

Item was added:
+ ----- Method: SugarLauncher>>isRunningInSugar (in category 'testing') -----
+ isRunningInSugar
+ 	^self parameters includesKey: 'ACTIVITY_ID'!

Item was added:
+ ----- Method: SugarLauncher>>isShared (in category 'testing') -----
+ isShared
+ 	^sharedActivity notNil!

Item was added:
+ ----- Method: SugarLauncher>>joinSharedActivity (in category 'presence') -----
+ joinSharedActivity
+ 	"join a shared activity on startup"
+ 	Utilities informUser: 'Looking for shared activity ...' translated
+ 		during: [
+ 			[sharedActivity := self presence getActivityById: self activityId]
+ 				ifError: [^sharedActivity := nil]].
+ 
+ 	Utilities informUser: 'Joining activity ...' translated
+ 		during: [
+ 			[sharedActivity join] ifError: [^sharedActivity := nil] .
+ 			self setupBuddies.
+ 			self setupTubes.
+ 			self enableSharedActivitySignals.
+ 			SugarNavigatorBar current ifNotNilDo: [:bar | bar joinSharedActivity].
+ 		].
+ 
+ !

Item was added:
+ ----- Method: SugarLauncher>>journal (in category 'accessing') -----
+ journal
+ 	^SugarJournal new	!

Item was added:
+ ----- Method: SugarLauncher>>leaveSharedActivity (in category 'presence') -----
+ leaveSharedActivity
+ 	sharedActivity ifNotNil: [
+ 		sharedActivity leaveAsync.
+ 		sharedActivity := nil.
+ 		self buddiesLock critical: [buddies := nil].
+ 		self deleteBadges].
+ !

Item was added:
+ ----- Method: SugarLauncher>>listeningTube (in category 'telepathy') -----
+ listeningTube
+ 	"our own tube id"
+ 	^tubes ifNotNil: [tubes keyAtValue: nil ifAbsent:[]]!

Item was added:
+ ----- Method: SugarLauncher>>makeJournalEntryFor:filename:mimetype: (in category 'datastore') -----
+ makeJournalEntryFor: aProject filename: aFilename mimetype: mimetypeString
+ 	"If this is a new project (no journal id yet), create a new Journal object, and remember the new id.
+ 	Otherwise, if this is an auto-save, update the existing Journal entry. 
+ 	But if it is an explicit save, always create a new entry. Which entry we continue to work on depends on the sugarAutoSave preference. If enabled (before 4.1), the new entry is just a checkpoint, the project continues to use the old id/entry, and will be saved again on quit. If disabled (default since 4.1), we switch to the newly created id/entry."
+ 	| id |
+ 	(id := aProject sugarObjectId)
+ 		ifNil: [
+ 			id := self createJournalEntryFor: aProject filename: aFilename mimetype: mimetypeString.
+ 			aProject sugarObjectId: id.
+ 			self monitorJournalEntry: id]
+ 		ifNotNil: [
+ 			(Preferences sugarAutoSave and: [aProject projectParameterAt: #sugarAutoSave ifAbsent: [true]])
+ 				ifTrue: [self updateJournalEntry: id for: aProject filename: aFilename mimetype: mimetypeString]
+ 				ifFalse: [
+ 					id := self createJournalEntryFor: aProject filename: aFilename mimetype: mimetypeString.
+ 					Preferences sugarAutoSave ifFalse: [
+ 						self unmonitorJournalEntry: aProject sugarObjectId.
+ 						aProject sugarObjectId: id.
+ 						self monitorJournalEntry: id]]]!

Item was added:
+ ----- Method: SugarLauncher>>monitorJournalEntry: (in category 'datastore') -----
+ monitorJournalEntry: objectId
+ 	self dataStore 
+ 		onUpdated: objectId
+ 		send: #updatedJournalEntry:
+ 		to: self.!

Item was added:
+ ----- Method: SugarLauncher>>newTube:initiator:type:service:parameters:state: (in category 'telepathy') -----
+ newTube: aTubeId initiator: anInitiatorId type: aType service: aServiceName parameters: aDictionary state: aState
+ 	"possibly sent via DBus in background process"
+ 
+ 	self tubesLock critical: [
+ 		| key buddy tube |
+ 		(tubes includesKey: aTubeId) ifTrue: [^self]. "our own tube"
+ 		key := aDictionary at: #buddy.
+ 		buddy := buddies at: key ifAbsent: [key].
+ 		(tube := SugarTube new)
+ 			id: aTubeId;
+ 			service: aServiceName;
+ 			buddy: buddy.
+ 		tubes at: aTubeId put: tube].
+ 	self tubeChanged: aTubeId state: aState.
+ !

Item was added:
+ ----- Method: SugarLauncher>>offerStreamTube:inBackgroundOnPort: (in category 'telepathy') -----
+ offerStreamTube: tcpServiceName inBackgroundOnPort: aBlock
+ 	[
+ 		| port |
+ 		[port := aBlock value.
+ 		port isNil] whileTrue: [(Delay forMilliseconds: 100) wait].
+ 		self offerStreamTube: tcpServiceName port: port.
+ 	] forkAt: Processor lowIOPriority
+ 		named: 'offer stream tube'!

Item was added:
+ ----- Method: SugarLauncher>>offerStreamTube:port: (in category 'telepathy') -----
+ offerStreamTube: tcpServiceName port: anInteger
+ 	self tubesLock critical: [
+ 		| tubeId |
+ 		tubeId := self getTubesChannel
+ 			offerStreamTube: tcpServiceName
+ 			with: {#buddy -> self ownerBuddy key} "params"
+ 			with: TelepathyChannel socketAddressTypeIPv4
+ 			with: ({'127.0.0.1'. anInteger} asDBusArgumentSignature: '(sq)')
+ 			with: 0 "accessControl"
+ 			with: 0. "accessControlParam".
+ 		tubes at: tubeId put: nil "mark as our own"]!

Item was added:
+ ----- Method: SugarLauncher>>open:title:mimetype: (in category 'chooser') -----
+ open: id title: titleString mimetype: mimeString
+ 	| file |
+ 	Utilities informUser: 'Opening journal entry' translated, String cr, 
+ 			(titleString copyReplaceAll: String lf with: String cr)
+ 		during: [file := self getFile: id].
+ 	self handleStream: file mimetype: mimeString titled: titleString.!

Item was added:
+ ----- Method: SugarLauncher>>ownerBuddy (in category 'accessing') -----
+ ownerBuddy
+ 	self isRunningInSugar ifTrue: [
+ 		"try old Presense Service"
+ 		[^SugarBuddy fromDictionary: self presence getOwner getProperties ]
+ 		on: DBusError do: [:ex |
+ 			"fall back on newer GConf"
+ 			^SugarBuddyOwner fromDictionary: (self gconfPropertiesAt: '/desktop/sugar/user')]].
+ 	"fake"
+ 	^SugarBuddyOwner key: '1234' nick: Utilities authorName colors: '#ff0000,#ffff00' ip: '1.2.3.4'!

Item was added:
+ ----- Method: SugarLauncher>>parameters: (in category 'running') -----
+ parameters: aDictionary
+ 	super parameters: aDictionary.
+ 
+ 	"prevent reading bundled project at startup on resuming a journal object. This is for Etoys-based Sugar activities (e.g. made using #bundle:)."
+ 
+ 	((parameters includesKey: 'OBJECT_ID') 
+ 		and: [(Smalltalk getSystemAttribute: 2) isEmptyOrNil not])
+ 			ifTrue: [Preferences disable: #readDocumentAtStartup]!

Item was added:
+ ----- Method: SugarLauncher>>presence (in category 'accessing') -----
+ presence
+ 	^DBus sessionBus get: SugarPresence!

Item was added:
+ ----- Method: SugarLauncher>>propertiesFrom: (in category 'datastore') -----
+ propertiesFrom: aProject
+ 	| preview autoSave props markFavorite setActivity |
+ 	preview := [ByteArray streamContents: [:s | PNGReadWriter 
+ 		putForm: (aProject thumbnail asFormOfDepth: 16)
+ 		onStream: s]] ifError: [''].
+ 	autoSave := aProject projectParameterAt: #sugarAutoSave ifAbsent: [true].
+ 	setActivity := Preferences sugarAutoSave not | autoSave.	
+ 	markFavorite := Preferences sugarAutoSave & autoSave not.
+ 	props := (aProject sugarProperties ifNil: [Dictionary new]) copy.
+ 	{
+ 		'activity' -> self bundleId.
+ 		'activity_id' -> (setActivity ifTrue: [self activityId] ifFalse: ['']).
+ 		'title:text' -> (self titleFromProject: aProject)  squeakToUtf8.
+ 		'title_set_by_user' -> (aProject currentVersionNumber>0 ifTrue: ['1'] ifFalse: ['0']).
+ 		'keep' -> (markFavorite ifTrue: ['1'] ifFalse: ['0']).
+ 		'mtime' -> (DateAndTime now asString first: 19).
+ 		'timestamp' -> (DateAndTime now asUnixTime).
+ 		'preview' -> preview.
+ 		'icon-color' -> self ownerBuddy colors.
+ 	} do: [:each | props add: each].
+ 	^props
+ !

Item was added:
+ ----- Method: SugarLauncher>>quit (in category 'commands') -----
+ quit
+ 	| autoSave |
+ 	autoSave := self shouldSaveOnQuit.
+ 
+ 	Preferences sugarAutoSave ifFalse: [
+ 		autoSave := false.
+ 		(self 
+ 			confirm: 'Are you sure you want to quit Etoys?
+ (the project will NOT be saved)' translated)
+ 				ifFalse: [^self]].
+ 
+ 	autoSave
+ 		ifFalse: [^Smalltalk quitPrimitive].
+ 
+ 	Project current
+ 		projectParameterAt: #sugarAutoSave put: true;
+ 		storeOnServerWithNoInteractionThenQuit.!

Item was added:
+ ----- Method: SugarLauncher>>resumeJournalEntry: (in category 'datastore') -----
+ resumeJournalEntry: id
+ 	| props file title project mimetype |
+ 	props := self getProperties: id.
+ 	title := props at: 'title' ifAbsent: ['untitled' translated].
+ 	mimetype := props at: 'mime_type' ifAbsent: [''].
+ 
+ 	mimetype isEmpty ifTrue: [^self welcome: ''].
+ 
+ 	mimetype = 'application/x-squeak-project' ifFalse: [
+ 		"reuse drop code"
+ 		WorldState addDeferredUIMessage: [
+ 			self open: id title: title mimetype: mimetype].
+ 		^Project enterNew].
+ 
+ 	ProjectLoading showProgressBarDuring: [
+ 		Display fillWhite;forceToScreen.
+ 		file := self getFile: id.
+ 		"load project and close temp file (which will thus be deleted)"
+ 		project := ProjectLoading 
+ 			loadName: ((title copyReplaceAll: '/' with: '\') contractTo: 64)
+ 			stream: file
+ 			fromDirectory: nil
+ 			withProjectView: nil.
+ 		file close.
+ 		project keepSugarProperties: props monitor: true.
+ 		project projectParameterAt: #sugarAutoSave put: true.
+ 		project enter].
+ !

Item was added:
+ ----- Method: SugarLauncher>>save (in category 'commands') -----
+ save
+ 	Project current 
+ 		projectParameterAt: #sugarAutoSave put: false;
+ 		storeOnServerWithNoInteraction!

Item was added:
+ ----- Method: SugarLauncher>>setupBuddies (in category 'presence') -----
+ setupBuddies
+ 	self badgeFlap.
+ 	self buddiesLock critical: [buddies := Dictionary new].
+ 	sharedActivity getJoinedBuddies do: [:each |
+ 		self buddyJoined: each].
+ !

Item was added:
+ ----- Method: SugarLauncher>>setupTubes (in category 'telepathy') -----
+ setupTubes
+ 	| tubesChannel |
+ 	self tubesLock critical: [tubes := Dictionary new].
+ 	tubesChannel := self getTubesChannel.
+ 	tubesChannel listTubes do: [:tubeArgs |
+ 		self perform: #newTube:initiator:type:service:parameters:state:
+ 			withArguments: tubeArgs].
+ 	tubesChannel
+ 		onNewTubeSend: #newTube:initiator:type:service:parameters:state: to: self;
+ 		onTubeStateChangedSend: #tubeChanged:state: to: self; 
+ 		onTubeClosedSend: #tubeClosed: to: self.
+ !

Item was added:
+ ----- Method: SugarLauncher>>sharePublicly: (in category 'presence') -----
+ sharePublicly: aBoolean
+ 	sharedActivity ifNotNil: [^self].
+ 
+ 	sharedActivity := self presence
+ 		shareActivity: self activityId
+ 		with: self bundleId
+ 		with: (self titleFromProject: Project current) squeakToUtf8
+ 		with: Dictionary new. "due to bug 4660 we can't pass properties directly"
+ 	sharedActivity setProperties: ({'private' -> aBoolean not} as: Dictionary).
+ 	self setupBuddies.
+ 	self enableSharedActivitySignals.
+ 	self setupTubes.
+ !

Item was added:
+ ----- Method: SugarLauncher>>shouldEnterHomeProject (in category 'testing') -----
+ shouldEnterHomeProject
+ 	"only if no other content is about to be loaded"
+ 	^Preferences eToyFriendly
+ 		and: [(Smalltalk getSystemAttribute: 2) isEmptyOrNil
+ 			and: [(self includesParameter: 'SRC') not
+ 				and: [Sensor hasDandDEvents not]]]
+ !

Item was added:
+ ----- Method: SugarLauncher>>shouldSaveOnQuit (in category 'testing') -----
+ shouldSaveOnQuit
+ 	"Don't save the home project to avoid confusion. Also, don't save if something was loaded from the XO bundle - this is for Etoys-based Sugar activities (e.g. made using #bundle:)."
+ 
+ 	^Project current ~~ Project home
+ 		and: [(Smalltalk getSystemAttribute: 2) isEmptyOrNil]!

Item was added:
+ ----- Method: SugarLauncher>>showBadges (in category 'presence') -----
+ showBadges
+ 	self badgeFlap openFully!

Item was added:
+ ----- Method: SugarLauncher>>shutDown (in category 'running') -----
+ shutDown
+ 	sharedActivity ifNotNil: [
+ 		self leaveSharedActivity.
+ 		sharedActivity := nil].
+ 	Project allSubInstancesDo: [:prj | prj removeParameter: #sugarId].
+ 	ServerDirectory inImageServers keysAndValuesDo: [:srvrName :srvr |
+ 		(srvr isKindOf: SugarDatastoreDirectory) ifTrue: [
+ 			ServerDirectory removeServerNamed: srvrName ifAbsent: []]].
+ 	Current := nil.
+ 	World windowEventHandler: nil.
+ !

Item was added:
+ ----- Method: SugarLauncher>>socketAddressForTube: (in category 'telepathy') -----
+ socketAddressForTube: tubeId
+ 	| tube |
+ 	tube := tubesLock critical: [tubes ifNotNil: [
+ 		tubes at: tubeId asInteger ifAbsent: []]].
+ 	^tube ifNotNil: [tube address]!

Item was added:
+ ----- Method: SugarLauncher>>startUp (in category 'running') -----
+ startUp
+ 	self class allInstances do: [:ea | ea shutDown].
+ 
+ 	Current := self.
+ 
+ 	SugarNavigatorBar current
+ 		ifNotNilDo: [:bar | bar startUp].
+ 
+ 	parameters at: 'ACTIVITY_ID' ifPresent: [ :activityId |
+ 		OLPCVirtualScreen setupIfNeeded.
+ 		World windowEventHandler: self.
+ 		DBus sessionBus 
+ 			export: SugarEtoysActivity new
+ 			on: 'org.laptop.Activity', activityId
+ 			at: '/org/laptop/Activity/', activityId.
+ 		Utilities authorName: self ownerBuddy nick.
+ 		ServerDirectory
+ 			addServer: (SugarDatastoreDirectory mimetype: 'application/x-squeak-project' extension: '.pr')
+ 			named: SugarLauncher defaultDatastoreDirName.
+ 		self joinSharedActivity.
+ 		self isShared ifFalse: [
+ 			parameters at: 'OBJECT_ID' ifPresent: [:id |
+ 				^self resumeJournalEntry: id]].
+ 		self isShared ifTrue: [^self].
+ 		^self welcome: (parameters at: 'URI' ifAbsent: [''])].
+ 
+ 	self welcome: ''
+ 
+ !

Item was added:
+ ----- Method: SugarLauncher>>takeScreenshot (in category 'commands') -----
+ takeScreenshot
+ 	"ignored - we can take a screenshot any time"!

Item was added:
+ ----- Method: SugarLauncher>>titleFromProject: (in category 'datastore') -----
+ titleFromProject: aProject
+ 	^(aProject name beginsWith: 'Unnamed' translated)
+ 		ifTrue: ['Etoys Project' translated]
+ 		ifFalse: [aProject name]!

Item was added:
+ ----- Method: SugarLauncher>>tubeChanged:state: (in category 'telepathy') -----
+ tubeChanged: tubeId state: tubeState
+ 	"sent via DBus in background process"
+ 	| socket tube |
+ 	(tubeState = TelepathyChannel tubeStateLocalPending and: [(tubes at: tubeId) service = 'sqk-etoy-p2p'])
+ 		ifTrue: [
+ 			socket := self getTubesChannel
+ 				acceptStreamTube: tubeId with: TelepathyChannel socketAddressTypeIPv4 with: 0 with: 0.
+ 			self tubesLock critical: [
+ 				tube := tubes at: tubeId.
+ 				tube address: socket first, ':', socket second asString].
+ 			WorldState addDeferredUIMessage: [
+ 				(self badgeFor: tube buddy) ipAddress: tube address].
+ 		].!

Item was added:
+ ----- Method: SugarLauncher>>tubeClosed: (in category 'telepathy') -----
+ tubeClosed: tubeId
+ 	"sent via DBus in background process"
+ 	| tube |
+ 	tube := self tubesLock critical: [tubes removeKey: tubeId ifAbsent: [^self]].
+ 	tube ifNotNil: [
+ 		WorldState addDeferredUIMessage: [
+ 			(self badgeFor: tube buddy) ifNotNilDo: [:badge |
+ 				badge ipAddress: 'tube closed']]].!

Item was added:
+ ----- Method: SugarLauncher>>tubesLock (in category 'telepathy') -----
+ tubesLock
+ 	^tubesLock ifNil: [tubesLock := Semaphore forMutualExclusion]!

Item was added:
+ ----- Method: SugarLauncher>>unmonitorJournalEntry: (in category 'datastore') -----
+ unmonitorJournalEntry: objectId
+ 	self dataStore 
+ 		onUpdated: objectId
+ 		send: nil
+ 		to: self.!

Item was added:
+ ----- Method: SugarLauncher>>updateJournalEntry: (in category 'datastore') -----
+ updateJournalEntry: id
+ 	^self updateJournalEntry: id
+ 		for: Project current
+ 		filename: ''
+ 		mimetype: ''!

Item was added:
+ ----- Method: SugarLauncher>>updateJournalEntry:for:filename:mimetype: (in category 'datastore') -----
+ updateJournalEntry: id for: aProject filename: aFilename mimetype: mimetypeString
+ 	"Move aProject saved to aFilename into the datastore, delete aFilename"
+ 	| properties |
+ 	properties := self propertiesFrom: aProject.
+ 	properties at: 'mime_type' put: mimetypeString.
+ 	self dataStore update: id with: properties with: aFilename squeakToUtf8 with: true.!

Item was added:
+ ----- Method: SugarLauncher>>updatedJournalEntry: (in category 'datastore') -----
+ updatedJournalEntry: objectId
+ 	"sent from DBus in background process"
+ 	| id project props |
+ 	id := objectId asString.
+ 	project := Project allProjects detect: [:each | each sugarObjectId = id] ifNone: [^self]. 
+ 	props := [self getProperties: objectId] on: DBusError do: [^self].
+ 	project keepSugarProperties: props monitor: false.!

Item was added:
+ ----- Method: SugarLauncher>>viewSource (in category 'commands') -----
+ viewSource
+  	WorldState addDeferredUIMessage: [
+ 		World showSourceKeyHit]!

Item was added:
+ ----- Method: SugarLauncher>>welcome: (in category 'commands') -----
+ welcome: aUrl
+ 	"Sent either when running from Sugar, or at regular startUp otherwise"
+ 
+ 	aUrl isEmpty ifFalse: [
+ 		| url |
+ 		url := (aUrl includes: $/)
+ 			ifTrue: [aUrl]
+ 			ifFalse: ['file:', (parameters at: 'BUNDLE_PATH'), '/', aUrl].
+ 		^(url endsWith: '.pr')
+ 			ifTrue: [Project fromUrl: url]
+ 			ifFalse: [WorldState addDeferredUIMessage: [FileStream fileIn: (url copyAfter: $:)]]].
+ 
+ 	self shouldEnterHomeProject ifTrue: [Project home ifNotNilDo: [:p | p enter]].!

Item was added:
+ ----- Method: SugarLauncher>>willSaveOnQuit (in category 'testing') -----
+ willSaveOnQuit
+ 
+ 	^Preferences sugarAutoSave
+ 		and: [self shouldSaveOnQuit]!

Item was added:
+ ----- Method: SugarLauncher>>windowEvent: (in category 'events') -----
+ windowEvent: anEvent
+ 	anEvent type == #windowClose
+ 		ifTrue: [^self quit].
+ !

Item was added:
+ Object subclass: #SugarLibrary
+ 	instanceVariableNames: 'iconDictionary'
+ 	classVariableNames: 'Default'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sugar'!
+ 
+ !SugarLibrary commentStamp: '<historical>' prior: 0!
+ THIS CLASS HAS NO COMMENT!!
+ 
+ Sugar button no haikei shoku ga okashii.!

Item was added:
+ ----- Method: SugarLibrary class>>chooseIcon (in category 'icons') -----
+ chooseIcon
+ 
+ 	^ Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '6cTjfv8AAAAT/wsLC/+4uLn/7+/v/4+Pj7r/AAAAB/9oaGkJ/wv/+fn5/xQUFLb/AAAAB/9+
+ f38N/wf/Li4vtv8AAAAH/35/fw3/B/8uLi+2/wAAAAf/fn9/Df8H/y4uL7b/AAAAB/9+f38N
+ /wf/Li4vtv8AAAAH/35/fw3/B/8uLi+2/wAAAAf/fn9/Df8H/y4uL7b/AAAAB/9+f38N/wf/
+ Li4vtv8AAAAH/35/fw3/B/8uLi+2/wAAAAf/fn9/Df8H/y4uL7b/AAAAB/9+f38N/wf/Li4v
+ ev8AAAAH/4aHiDr/ury+B//GyMkN/wf/vb3AOv+6vL4H/1dYWT7/AAAAB/+PkJI6/8bIygf/
+ y8zODf8H/8XHyjr/xsjKB/9dXl8+/wAAAAf/j5CSOv/GyMoH/8vMzg3/B//Fx8o6/8bIygf/
+ XV5fPv8AAAAH/4+Qkjr/xsjKB//LzM4N/wf/xcfKOv/GyMoH/11eXz7/AAAAB/+PkJIi/8bI
+ ygv/xcfK/8XHyRL/xsjKB//LzM4N/wf/xcfKEv/GyMoL/8bHyf/Fx8ki/8bIygf/XV5fPv8A
+ AAAH/4+Qkh7/xsjKE//X2Nj//////+7u7v/Fx8oO/8bIygf/y8zODf8H/8XHyg7/xsjKE//K
+ y8z/+/v7///////Jyswe/8bIygf/XV5fPv8AAAAH/4+Qkhr/xsjKC//Hycv/+vr6Cf8L//Dw
+ 8P/Fx8kK/8bIygf/y8zODf8H/8XHygr/xsjKC//Hycr//Pz8Cf8H/+Dh4h7/xsjKB/9dXl8+
+ /wAAAAf/j5CSHv/GyMoH/+Hh4g3/E//l5eb/xcfJ/8bIyv/LzM4N/xP/xcfK/8bIyv/Fx8r/
+ 9fX1Df8H/87P0B7/xsjKB/9dXl8+/wAAAAf/j5CSHv/GyMoL/8XHyf/w8PAN/w//2tvb/8bI
+ yv/LzM4N/w//xcfK/8XHyf/r7OwN/wv/3t/g/8XHyR7/xsjKB/9dXl8+/wAAAAf/j5CSIv/G
+ yMoL/8XHyv/4+PgN/wv/0NHS/8vMzg3/C//GyMv/4OHiDf8L/+rq6v/GyMki/8bIygf/XV5f
+ Pv8AAAAH/4+Qkib/xsjKC//Iycv//v7+Df8H/9bX2A3/B//Z2dsN/wv/8/P0/8XHySb/xsjK
+ B/9dXl8+/wAAAAf/j5CSKv/GyMoH/83Ozw3/B//8/PwZ/wv/+/v7/8fIySr/xsjKB/9dXl8+
+ /wAAAAf/j5CSLv/GyMoH/9bX2CX/B//Kyswu/8bIygf/XV5fPv8AAAAH/4+Qki7/xsjKC//H
+ ycv/4eLiHf8H/9DR0jL/xsjKB/9dXl8+/wAAAAf/j5CSMv/GyMoL/8XHyf/s7O0V/wf/2tvc
+ Nv/GyMoH/11eXz7/AAAAB/+PkJI2/8bIygv/xsfJ//j4+Q3/C//o6On/x8nKNv/GyMoH/11e
+ Xz7/AAAAB/+PkJI6/8bIygf/yMjKCf8L//r6+v/GyMk6/8bIygf/XV5fPv8AAAAH/4+Qkj7/
+ xsjKD//Fx8j/0NHS/8fJyz7/xsjKB/9dXl8+/wAAAAf/j5CShv/GyMoH/11eXz7/AAAAB/+P
+ kJKG/8bIygf/XV5fPv8AAAAH/4+Qkob/xsjKB/9dXl8+/wAAAAf/j5CShv/GyMoH/11eXz7/
+ AAAAB/+PkJKG/8bIygf/XV5fPv8AAAAH/4+Qkob/xsjKB/9dXl8+/wAAAAf/j5CShv/GyMoH
+ /11eXz7/AAAAB/8kJCSG/zIyMwf/FxgY5l7/AAAA' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>clearDefault (in category 'singleton management') -----
+ clearDefault
+ "
+ 	SugarLibrary clearDefault
+ "
+ 	Default _ nil.
+ !

Item was added:
+ ----- Method: SugarLibrary class>>closeIcon (in category 'icons') -----
+ closeIcon
+ 	^Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '6cTh2v8AAAA3/xoaGv9cXFz/kJCQ/7e3t//Y2Nj/4+Pj/+7u7v/l5eX/2tra/7u7u/+VlZX/
+ YmJi/yIiIor/AAAAD/8UFBT/cXFx/87OzjX/D//W1tb/e3t7/xwcHHb/AAAAD/8ZGRn/j4+P
+ //T09EX/D//5+fn/nJyc/yIiImb/AAAAD/8DAwP/bm5u//Dw8FX/D//29vb/fn5+/wcHB1r/
+ AAAAC/8YGBj/vr6+Zf8L/8/Pz/8lJSVS/wAAAAv/MzMz/+jo6G3/C//x8fH/Q0NDSv8AAAAL
+ /z4+Pv/x8fF1/wv/+fn5/1RUVEL/AAAAC/8yMjL/8PDwff8L//n5+f9CQkI6/wAAAAv/GRkZ
+ /+jo6IX/C//x8fH/KCgoMv8AAAAL/wMDA/+/v7+N/wv/09PT/woKCi7/AAAAB/9ubm6V/wf/
+ iIiIKv8AAAAL/xgYGP/x8fEh/xf/3d3d/2RkZP8/Pz//cnJy/+3t7S3/F//k5OT/aWlp/z8/
+ P/9tbW3/5+fnIf8L//r6+v8oKCgm/wAAAAf/jo6OIf8L/9zc3P8NDQ0O/wAAAAv/HBwc/9nZ
+ 2SX/C//Ly8v/ERERDv8AAAAL/xgYGP/r6+sh/wf/qampIv8AAAAL/xQUFP/09PQh/wf/Y2Nj
+ Fv8AAAAL/xsbG//Z2dkd/wv/y8vL/xAQEBb/AAAAB/9+fn4h/wv//f39/ycnJx7/AAAAB/9v
+ b28l/wf/QUFBGv8AAAAL/xsbG//Z2dkV/wv/zMzM/xAQEBr/AAAAB/9aWlol/wf/ioqKHv8A
+ AAAH/83NzSX/B/9ycnIe/wAAAAv/Gxsb/9nZ2Q3/C//MzMz/EBAQHv8AAAAH/4uLiyX/C//l
+ 5eX/AwMDFv8AAAAH/xoaGin/C//t7e3/HBwcHv8AAAAX/xsbG//Z2dn//////8zMzP8QEBAe
+ /wAAAAv/KSkp//b29in/B/80NDQW/wAAAAf/W1tbLf8L/9nZ2f8aGhoe/wAAAA//Gxsb/6io
+ qP8QEBAe/wAAAAv/JiYm/+Xl5S3/B/92dnYW/wAAAAf/kJCQMf8L/9nZ2f8aGho+/wAAAAv/
+ JiYm/+Xl5TH/B/+rq6sW/wAAAAf/tbW1Nf8L/9nZ2f8aGho2/wAAAAv/JiYm/+Xl5TX/B//S
+ 0tIW/wAAAAf/1tbWOf8L/9nZ2f8aGhou/wAAAAv/Jycn/+Xl5Tn/B//x8fEW/wAAAAf/4uLi
+ Pf8L/9nZ2f8aGhom/wAAAAv/Jycn/+Xl5UH/Fv8AAAAH//Dw8EH/B/+np6cm/wAAAAf/v7+/
+ Rf8H/w8PDxL/AAAAB//j4+M9/wv/y8vL/xAQECb/AAAAC/8bGxv/2dnZQf8H/wICAhL/AAAA
+ B//X19c5/wv/y8vL/xAQEC7/AAAAC/8bGxv/2dnZOf8H//Pz8xb/AAAAB/+6uro1/wv/y8vL
+ /xAQEDb/AAAAC/8bGxv/2dnZNf8H/9XV1Rb/AAAAB/+Tk5Mx/wv/y8vL/xAQED7/AAAAC/8a
+ Ghr/2dnZMf8H/6+vrxb/AAAAB/9gYGAt/wv/y8vL/xAQEB7/AAAAD/8mJib/v7+//xoaGh7/
+ AAAAC/8aGhr/2dnZLf8H/3x8fBb/AAAAB/8gICAp/wv/4+Pj/xISEh7/AAAAF/8mJib/5eXl
+ ///////Z2dn/GhoaHv8AAAAL/x4eHv/w8PAp/wf/Ojo6Gv8AAAAH/9bW1iX/B/9oaGge/wAA
+ AAv/JiYm/+Xl5Q3/C//Z2dn/GhoaHv8AAAAH/4ODgyX/C//r6+v/BQUFGv8AAAAH/3l5eSX/
+ B/9BQUEa/wAAAAv/JiYm/+Xl5RX/C//Y2Nj/GhoaGv8AAAAH/1paWiX/B/+Tk5Me/wAAAAv/
+ Ghoa//n5+SH/B/9sbGwW/wAAAAv/JiYm/+Xl5R3/C//Y2Nj/GhoaFv8AAAAH/4aGhiH/C//+
+ /v7/MTExIv8AAAAH/5qamiH/C//n5+f/GBgYDv8AAAAL/yoqKv/l5eUl/wv/2NjY/x0dHQ7/
+ AAAAC/8lJSX/8/PzIf8H/7S0tCb/AAAAC/8gICD/9vb2If8X/+vr6/9+fn7/Wlpa/4mJif/2
+ 9vYt/xf/8PDw/4KCgv9aWlr/hoaG//Ly8iH/C//9/f3/NDQ0Kv8AAAAH/3t7e5X/B/+WlpYu
+ /wAAAAv/BgYG/8zMzI3/C//e3t7/EBAQMv8AAAAL/yIiIv/w8PCF/wv/+fn5/zQ0NDr/AAAA
+ C/9CQkL/+fn5ff8L//7+/v9bW1tC/wAAAAv/UlJS//n5+XX/C//9/f3/ZmZmSv8AAAAL/0ND
+ Q//y8vJt/wv/+Pj4/1dXV1L/AAAAC/8oKCj/0tLSZf8L/97e3v80NDRa/wAAAA//CAgI/4eH
+ h//5+flV/w///f39/5eXl/8QEBBm/wAAAA//KCgo/6enp//9/f1F/w///v7+/7S0tP8yMjJ2
+ /wAAAA//JiYm/4iIiP/l5eU1/w//6+vr/5OTk/8wMDCG/wAAABv/AgIC/zMzM/91dXX/qqqq
+ /9DQ0P/v7+8N/xv/8vLy/9XV1f+urq7/fHx8/zs7O/8EBASq/wAAAAf/DQ0N4fb/AAAA' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>default (in category 'singleton management') -----
+ default
+ 	"Answer the default instance of the receiver, which is held as a class variable.  If the Default is not yet set up, set it up at this time."
+ 
+ 	^ Default ifNil: [Default _ self newDefault].
+ 
+ "
+ Default := nil.
+ "
+ !

Item was added:
+ ----- Method: SugarLibrary class>>defaultIconHeight (in category 'singleton management') -----
+ defaultIconHeight
+ 
+ 	^ 75.
+ !

Item was added:
+ ----- Method: SugarLibrary class>>helpIcon (in category 'icons') -----
+ helpIcon
+ 	"self helpIcon asMorph openInHand"
+ 	^  (PNGReadWriter on: (Base64MimeConverter mimeDecodeToBytes: 'iVBORw0KGgoAAAANSUhEUgAAADIAAAAyCAYAAAAeP4ixAAAABHNCSVQICAgIfAhkiAAAAAlw
+ SFlzAAANrAAADawB7wbGRwAAACV0RVh0U29mdHdhcmUATWFjcm9tZWRpYSBGaXJld29ya3Mg
+ TVggMjAwNId2rM8AAAI/SURBVHic7Zq7iupQFIZ/x1NoEUmRwkQb8QaKplAsxM7OvINP4WP4
+ CtaChU1qn0E0rRAt4pWIFzSCJHMqhRwzhzCz9xhCvvLfsv/1s9byHgLwCR/w8e4CSPHHSex2
+ u79dh2s6nY6j7puOBEG8huOO/EupVEIikaBdywuapkFRFFePdRUkkUigWCz+qKjv4jaIb0Yr
+ COI1qAcxTZO2BQCXy+6Ww+EAVVWxWCyg6zrO5zNM00Q0GkUsFkMymUSlUgHDMCRtARAMcjqd
+ 0Ov1HM8Mw4BhGNhsNhiPx2g2myiXy6SsAbxhRyzLwmg0wmq1Inov0dF6wLIseJ4Hx3HQdR2q
+ qsIwjOe5ZVmYTqfgeZ6YJ9EgHMehXq8jm83a9OVyiX6/b9N2ux1Ja3JBGIZBu91GKBR6ORME
+ AZFIBLfb7alZlkXKGgDBIE4BHqzXa1sIAETHCviFZb9er5Bl+UXPZDJEfags+4PL5YLBYIDT
+ 6WTTa7UaUqkUUS9qHbnf7xgOh9jv9zY9nU6j0WgQ96PWEVmWsd1ubVoul4MkSf/dp+9CpSPH
+ 4xGqqto0nufRarXw8UFnCKjc6vSqXSgUEA6HadgBoDRa8XgckiTZNEEQaFg9ofYWhWVZGld/
+ CZUg8/kck8nEplWrVapfYFAJcjweMZvNbFo+n6dh9ST4qOs1fBOEyo6IoghRFGlc/SW+6UgQ
+ xGsEQbyGb4K4evrVNI12HT/2dRVEURTXP7i8C9+MVhDEawRBvIZvgoQQ/M3JW/gmyF+WjKG7
+ Y8WsvAAAAABJRU5ErkJggg==' readStream) readStream) nextImage.!

Item was added:
+ ----- Method: SugarLibrary class>>hideNavBarIcon (in category 'icons') -----
+ hideNavBarIcon
+ 	"Answer a form with the hideNavBar picture"
+ 
+ 	^ Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: 
+ 
+ '6cThmQC5/xEAuf8RALn/EQC5/xEAuf8RALn/EQC5/xEAuf8RAGn/MQAh/xEAaf8xACH/EQBp
+ /zEAIf8RAIH/GQAh/xEAff8dACH/EQB5/yEAIf8RAHX/FQAF/w0AIf8RAHH/FQAJ/w0AIf8R
+ AG3/FQAN/w0AIf8RAGn/FQAR/w0AIf8RAGX/FQAV/w0AIf8RAGX/EQAZ/w0AIf8RAGX/DQBJ
+ /xEAuf8RALn/EQC5/xEAuf8RACH/DQAd/w0AZf8RACH/DQAZ/xEAZf8RACH/DQAV/xUAZf8R
+ ACH/DQAR/xUAaf8RACH/DQAN/xUAbf8RACH/DQAJ/xUAcf8RACH/DQAF/xUAdf8RACH/IQB5
+ /xEAIf8dAH3/EQAh/xkAgf8RACH/NQBl/xEAIf81AGX/EQAh/zUAZf8RALn/EQC5/xEAuf8R
+ ALn/EQC5/xEAuf8RALn/EQC5/+GZAA=='
+ 
+ readStream) contents.
+ 
+ !

Item was added:
+ ----- Method: SugarLibrary class>>keepIcon (in category 'icons') -----
+ keepIcon
+ 
+ 	^ Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '6cTiSv8AAAAH/wEBAaL/AAAAB/8gICAe/wAAABP/Nzc3/4+Pj/91dXX/DAwMUv8AAAAX/xgY
+ GP9DQ0P/TU1N/0VFRf8mJiYu/wAAABf/Dg4O/3l5ef/Gxsb/eXl5/w4ODhL/AAAAC/8xMTH/
+ 1dXVCf8H/01NTUr/AAAAI/8VFRX/S0tL/3Z2dv+UlJT/m5ub/5WVlf+AgID/OTk5Kv8AAAAX
+ /yoqKv/n5+f//////+jo6P8rKysO/wAAAAv/MzMz/9nZ2Qn/C//9/f3/Q0NDQv8AAAAv/xMT
+ E/9MTEz/eHh4/4+Pj/+Tk5P/jIyM/4qKiv+MjIz/k5OT/4KCgv8VFRUm/wAAABf/MzMz//Dw
+ 8P//////6enp/zAwMAr/AAAAC/8zMzP/2traCf8P//r6+v9xcXH/BgYGOv8AAAA3/wgICP9C
+ QkL/fHx8/46Ojv+RkZH/i4uL/4mJif+YmJj/tra2/5ycnP+Kior/jY2N/z09PSb/AAAAI/9D
+ Q0P//f39///////AwMD/GRkZ/wAAAP8yMjL/2traCf8P//r6+v9tbW3/AQEBNv8AAAAX/woK
+ Cv84ODj/eHh4/46Ojv+Pj48K/4qKiiP/l5eX/7+/v//w8PD//Pz8/7CwsP+EhIT/i4uL/0JC
+ Qib/AAAAB/9FRUUJ/xP/uLi4/xEREf8uLi7/2dnZCf8L//r6+v9vb282/wAAACv/DQ0N/zIy
+ Mv9zc3P/kJCQ/46Ojv+Kior/h4eH/5aWlv+7u7v/7e3tDf8T/7Gxsf+EhIT/i4uL/0FBQSb/
+ AAAAB/9WVlYJ/w//q6ur/0ZGRv/R0dEJ/wv/+fn5/3R0dDL/AAAAK/8NDQ3/NTU1/29vb/+S
+ kpL/jo6O/4qKiv+Ghob/lZWV/7Ozs//k5OQV/xP/sbGx/4SEhP+Li4v/QEBAJv8AAAAH/3R0
+ dAn/C/+2trb/1tbWCf8L//n5+f90dHQu/wAAACv/CAgI/y8vL/9nZ2f/lJSU/5CQkP+Li4v/
+ ioqK/5KSkv+zs7P/3t7eHf8f/7Gxsf+EhIT/i4uL/0NDQ/8DAwP/BAQE/wMDAxb/AAAAC/8C
+ AgL/fHx8Ff8L/+/v7/9mZmYu/wAAACv/HBwc/2BgYP+Ojo7/lJSU/4uLi/+Hh4f/i4uL/4WF
+ hf+urq7//f39If8n/7Gxsf+EhIT/jIyM/3Fxcf9aWlr/W1tb/1xcXP9FRUX/EhISDv8AAAAL
+ /woKCv+cnJwR/yP//v7+/6Ghof8yMjL/Wlpa/1ZWVv9xcXH/Y2Nj/woKChr/AAAAK/9JSUn/
+ nZ2d/4+Pj/+IiIj/i4uL/7y8vP/Hx8f/fn5+/7a2tv/9/f0h/xP/sbGx/4ODg/+MjIz/kZGR
+ Cv+WlpYT/5eXl/+Tk5P/cHBw/xsbGwr/AAAAC/8ODg7/qKioFf8T/9PT0//c3Nz/+fn5//b2
+ 9gn/B/9iYmIa/wAAACv/S0tL/5qamv+Kior/p6en/9zc3P/8/Pz/5+fn/3t7e/+0tLT//Pz8
+ If8T/7Gxsf+Dg4P/jIyM/4qKig7/iYmJH/+NjY3/lZWV/2pqav8KCgr/AAAA/w0NDf+np6ct
+ /wf/hISEGv8AAAAT/0pKSv+ZmZn/ioqK/76+vgn/E//g4OD/fHx8/7S0tP/8/Pwh/xP/sbGx
+ /4ODg/+NjY3/srKyCv/W1tYj/7y8vP+Pj4//i4uL/5CQkP8nJyf/AAAA/woKCv+bm5sJ/wr/
+ /v7+I//9/f3/+/v7//n5+f/a2tr/yMjI/8DAwP+JiYn/IiIiGv8AAAAr/0lJSf+ZmZn/ioqK
+ /7+/v//9/f3//////+Dg4P98fHz/tLS0//z8/CH/E/+xsbH/g4OD/42Njf/Ly8sJ/xf/+Pj4
+ /7CwsP+EhIT/kJCQ/0ZGRgr/AQEBB/8iIiIK/3x8fCf/VlZW/05OTv84ODj/HBwc/xoaGv8U
+ FBT/ERER/w8PD/8FBQUe/wAAABP/SkpK/5mZmf+Kior/v7+/Cf8T/+Dg4P98fHz/tLS0//z8
+ /CH/E/+xsbH/g4OD/42Njf/KysoN/xf/wsLC/4GBgf+Ojo7/T09P/wICAkr/AAAAM/8GBgb/
+ IiIi/2tra/+Tk5P/ioqK/6mpqf/k5OT/+vr6/+Dg4P98fHz/tLS0//z8/CH/E/+xsbH/g4OD
+ /42Njf/KysoN/xf/wsLC/4GBgf+Ojo7/Tk5O/wICAkr/AAAAM/8xMTH/n5+f/5aWlv+Kior/
+ jIyM/4SEhP+Hh4f/39/f/+Li4v98fHz/tLS0//z8/CH/E/+xsbH/g4OD/42Njf/KysoN/xf/
+ wsLC/4GBgf+Ojo7/Tk5O/wICAkr/AAAAM/8lJSX/W1tb/3Nzc/+QkJD/jIyM/5ubm/+0tLT/
+ 6+vr/+Hh4f98fHz/tLS0//z8/CH/E/+xsbH/g4OD/42Njf/KysoN/xf/wsLC/4GBgf+Ojo7/
+ Tk5O/wICAlL/AAAAK/9KSkr/mZmZ/4qKiv+8vLz/+/v7///////g4OD/fHx8/7S0tP/8/Pwh
+ /xP/sbGx/4ODg/+NjY3/ysrKDf8X/8LCwv+BgYH/jo6O/05OTv8CAgJS/wAAABP/SUlJ/5mZ
+ mf+Kior/v7+/Cf8T/+Dg4P98fHz/tLS0//z8/CH/E/+xsbH/g4OD/42Njf/KysoN/xf/wsLC
+ /4GBgf+Ojo7/Tk5O/wICAlL/AAAAK/9KSkr/mZmZ/4qKiv++vr7//f39///////g4OD/fHx8
+ /7S0tP/8/Pwh/xP/sbGx/4ODg/+NjY3/ysrKDf8X/8LCwv+BgYH/jo6O/05OTv8CAgJS/wAA
+ ACv/SkpK/5mZmf+Kior/vr6+//39/f//////4ODg/3x8fP+0tLT//Pz8If8T/7Gxsf+Dg4P/
+ jY2N/8rKyg3/F//CwsL/gYGB/46Ojv9OTk7/AgICUv8AAAAr/0pKSv+ZmZn/ioqK/76+vv/9
+ /f3//////+Dg4P98fHz/tLS0//z8/CH/E/+xsbH/g4OD/42Njf/KysoN/xf/wsLC/4GBgf+O
+ jo7/Tk5O/wICAlL/AAAAE/9FRUX/mpqa/4qKiv/BwcEJ/xP/4ODg/3x8fP+0tLT//Pz8If8T
+ /7Gxsf+Dg4P/jY2N/8rKyg3/F//CwsL/gYGB/46Ojv9OTk7/AgICSv8AAAAz/wICAv8aGhr/
+ Xl5e/5aWlv+Kior/sLCw/+zs7P//////4ODg/3x8fP+0tLT//Pz8If8T/7Gxsf+Dg4P/jY2N
+ /8rKyg3/F//CwsL/gYGB/46Ojv9OTk7/AgICSv8AAAAP/ycnJ/+Dg4P/kZGRCv+MjIwf/4iI
+ iP+goKD/6+vr/+Li4v98fHz/tLS0//z8/CH/E/+xsbH/g4OD/42Njf/KysoN/xf/wsLC/4GB
+ gf+Ojo7/Tk5O/wICAkr/AAAAM/8uLi7/f39//4ODg/+Ojo7/jIyM/5SUlP+ZmZn/4ODg/+Li
+ 4v98fHz/tLS0//z8/CH/E/+xsbH/g4OD/42Njf/KysoN/xf/wsLC/4GBgf+Ojo7/Tk5O/wIC
+ Akr/AAAAM/8FBQX/FxcX/1dXV/+Xl5f/ioqK/7e3t//n5+f//v7+/+Dg4P98fHz/tLS0//z8
+ /CH/E/+xsbH/g4OD/42Njf/KysoN/xf/wsLC/4GBgf+Ojo7/Tk5O/wICAlL/AAAAE/9HR0f/
+ mpqa/4qKiv/AwMAJ/xP/4ODg/3x8fP+0tLT//Pz8If8T/7Gxsf+Dg4P/jY2N/8rKyg3/F//C
+ wsL/gYGB/46Ojv9OTk7/AgICUv8AAAAr/0pKSv+ZmZn/ioqK/76+vv/9/f3//////+Dg4P98
+ fHz/tLS0//z8/CH/E/+xsbH/g4OD/42Njf/KysoN/xf/wsLC/4GBgf+Ojo7/Tk5O/wICAlL/
+ AAAAK/9KSkr/mZmZ/4qKiv++vr7//f39///////g4OD/fHx8/7S0tP/8/Pwh/xP/sbGx/4OD
+ g/+NjY3/ysrKDf8X/8LCwv+BgYH/jo6O/05OTv8CAgJS/wAAACv/SkpK/5mZmf+Kior/vr6+
+ //39/f//////4ODg/3x8fP+0tLT//Pz8If8T/7Kysv+Dg4P/jY2N/8rKyg3/F//CwsL/gYGB
+ /46Ojv9OTk7/AgICUv8AAAAr/0hISP+ZmZn/ioqK/7+/v//+/v7//////+Dg4P98fHz/tLS0
+ //z8/B3/F//7+/v/p6en/4SEhP+MjIz/yMjIDf8X/8LCwv+BgYH/jo6O/05OTv8CAgJS/wAA
+ ABP/TU1N/5mZmf+Kior/vb29Cf8T/+Dg4P98fHz/tLS0//z8/Bn/G//n5+f/uLi4/46Ojv+K
+ ior/jIyM/9zc3A3/F//CwsL/gYGB/46Ojv9OTk7/AgICSv8AAAAz/xUVFf9GRkb/eHh4/5GR
+ kf+Li4v/nZ2d/8PDw//09PT/4eHh/3x8fP+0tLT//Pz8Df8n//f39//Z2dn/vb29/5qamv+F
+ hYX/i4uL/4aGhv+urq7//f39Df8X/8LCwv+BgYH/jo6O/05OTv8CAgJK/wAAAC//PDw8/6en
+ p/+VlZX/ioqK/4yMjP+Dg4P/goKC/9vb2//i4uL/fHx8/7W1tQn/K//j4+P/wsLC/6ioqP+R
+ kZH/hISE/4iIiP+Li4v/g4OD/6mpqf/v7+8R/xf/wsLC/4GBgf+Ojo7/Tk5O/wICAkr/AAAA
+ W/8XFxf/NjY2/2VlZf+Tk5P/i4uL/6urq//Nzc3/9fX1/+Li4v9+fn7/q6ur/8/Pz/+vr6//
+ l5eX/4iIiP+EhIT/iYmJ/4qKiv+Ghob/mJiY/8jIyP/09PQV/xf/wsLC/4GBgf+Ojo7/Tk5O
+ /wICAlL/AAAAE/9JSUn/mZmZ/4qKiv/BwcEJ/xP/0dHR/4SEhP+Pj4//kJCQCv+Hh4cb/4mJ
+ if+Li4v/j4+P/6mpqf/U1NT/8fHxHf8X/8LCwv+BgYH/jo6O/05OTv8CAgJS/wAAAEP/SUlJ
+ /5mZmf+Li4v/tra2/83Nzf+np6f/kZGR/4yMjP+Li4v/ioqK/4yMjP+Pj4//mpqa/8LCwv/o
+ 6Oj/+fn5Jf8X/7a2tv+EhIT/j4+P/0dHR/8BAQFS/wAAABf/SkpK/5mZmf+MjIz/jY2N/4yM
+ jAr/ioqKDv+MjIwT/4+Pj/+rq6v/0dHR/9fX1wr/2dnZB//X19ca/9bW1hv/2tra/8fHx/+X
+ l5f/iYmJ/5KSkv8uLi5W/wAAAAv/S0tL/5qamgr/jIyMB/+Li4sa/4yMjAr/i4uLMv+KiooT
+ /4yMjP+UlJT/fHx8/w4ODlb/AAAAC/9KSkr/n5+fVv+WlpYX/5WVlf+Xl5f/lpaW/39/f/8q
+ Kipa/wAAAA//Hh4e/1hYWP9gYGBW/15eXg//X19f/09PT/8gICBm/wAAAAf/BQUFUv8EBAQL
+ /wUFBf8EBATirv8AAAA=' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>languageIcon (in category 'icons') -----
+ languageIcon
+ 
+ 	^ Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '6cTjPv8AAAAT/wgICP8rKyv/RkZG/1dXVxb/aWlpE/9gYGD/RkZG/ysrK/8RERGO/wAAAAv/
+ CAgI/2lpaTb/jIyME/96enr/V1dX/zQ0NP8ICAhG/wAAABP/CAgI/2lpaf+Dg4P/PT09Kv8A
+ AAAH/z09PUr/jIyMD/9gYGD/NDQ0/wgICDb/AAAAC/8rKyv/g4ODDv+MjIwq/wAAAAf/Tk5O
+ Ev+MjIwH/5OTkxb/qKioB/+Tk5Mq/4yMjA//YGBg/z09Pf8REREi/wAAAAv/ERER/2BgYBb/
+ jIyMKv8AAAAH/2lpaQr/jIyMC/+hoaH/8PDwHf8T//f39//i4uL/xcXF/6GhoSb/jIyMD/96
+ enr/V1dX/0ZGRgr/IyMjD/8rKyv/RkZG/3FxcRr/jIyMB/9xcXEq/wAAAAf/g4ODCv+MjIwH
+ /6+vrzH/D//39/f/09PT/6+vr1L/jIyMB/9gYGAm/wAAAAf/CAgIDv+MjIwH/8XFxT3/D//3
+ 9/f/09PT/6+vrzb/jIyMB/+Tk5MO/4yMjAf/RkZGJv8AAAAH/yMjIw7/jIyMB//b29sJ/xP/
+ 6enp/8zMzP+vr6//qKioGv+MjIwT/6ioqP+vr6//xcXF/+Li4gn/E//39/f/29vb/76+vv+o
+ qKga/4yMjBP/mpqa/7e3t//b29v/4uLiDv+MjIwH/ysrKwr/AAAAC/8aGhr/CAgIFv8AAAAH
+ /z09PQ7/jIyMD//p6en//////7e3tz7/jIyMD/+vr6//zMzM//Dw8A3/B//39/cO/+Li4hH/
+ B//MzMwO/4yMjBv/Ghoa/wgICP9gYGD/jIyM/4ODg/8aGhoS/wAAAAf/Tk5ODv+MjIwJ/07/
+ jIyMD/+hoaH/zMzM//Dw8CH/B/++vr4O/4yMjAv/IyMj/3p6eg7/jIyMB/9GRkYS/wAAAAf/
+ aWlpCv+MjIwP/6Ghof//////6enpEv+MjIwL/6ioqP++vr4S/8XFxQ//t7e3/6ioqP+Tk5Mm
+ /4yMjA//oaGh/8XFxf/i4uIV/wf/qKioIv+MjIwH/z09PRL/AAAAB/+Dg4MK/4yMjA//r6+v
+ ///////b29sO/4yMjAf/4uLiJf8P/+np6f/MzMz/r6+vKv+MjIwL/6ioqP+3t7cK/8XFxQf/
+ k5OTIv+MjIwH/yMjIw7/AAAAB/8ICAgO/4yMjA//xcXF///////FxcUO/4yMjAf/9/f3Nf8P
+ /9vb2/+3t7f/k5OTTv+MjIwH/wgICA7/AAAAB/8jIyMO/4yMjA//29vb//////+vr68K/4yM
+ jAf/k5OTMf8j//f39//i4uL/29vb/8zMzP/i4uL/xcXF/7e3t/+Tk5Mu/4yMjAr/mpqaCv+M
+ jIwH/4ODgxL/AAAAB/89PT0O/4yMjA//6enp//////+hoaEK/4yMjAf/qKioKf8L/9PT0/+h
+ oaEa/4yMjB//mpqa/8XFxf/i4uL/zMzM/6+vr/+oqKj/k5OTCv+MjIwb/5qamv+oqKj/xcXF
+ /+np6f//////oaGhCv+MjIwH/2lpaRL/AAAAB/9OTk4O/4yMjAn/Dv+MjIwH/76+viH/C//b
+ 29v/mpqaKv+MjIwL/5OTk//b29sp/w7/jIyMB/9OTk4S/wAAAAf/aWlpCv+MjIwP/6Ghof//
+ ////6enpDv+MjIwH/8zMzB3/B/++vr4K/4yMjAv/mpqa/6ioqB7/jIyMB/+ampoK/4yMjAf/
+ 09PTIf8H/+np6Q7/jIyMB/89PT0S/wAAAAf/g4ODCv+MjIwP/6+vr///////29vbDv+MjIwH
+ /+Li4hn/B/+3t7cK/4yMjAv/vr6+/8zMzAr/jIyMI/+3t7f/xcXF/4yMjP+vr6//k5OT/4yM
+ jP/FxcX/t7e3Cv+MjIwH/9vb2x3/B//b29sO/4yMjAf/IyMjDv8AAAAH/wgICA7/jIyMD//F
+ xcX//////8XFxQ7/jIyMB//39/cV/wf/09PTCv+MjIxH/9PT0//w8PD/k5OT/4yMjP+3t7f/
+ /////6+vr/+MjIz/zMzM/9vb2/+MjIz/k5OT//f39/+3t7f/jIyM/5OTk//39/cZ/wf/xcXF
+ Dv+MjIwH/wgICA7/AAAAB/8jIyMO/4yMjA//29vb//////+vr68K/4yMjAf/k5OTFf8j//f3
+ 9/+Tk5P/jIyM/8XFxf//////t7e3/4yMjP+oqKgJ/y//oaGh/4yMjP/i4uL//////5qamv+M
+ jIz/09PT//////+ampr/jIyM/8zMzBn/B/+vr68K/4yMjAf/g4ODEv8AAAAH/z09PQ7/jIyM
+ D//p6en//////6GhoQr/jIyMB/+oqKgV/xf/t7e3/4yMjP+oqKj///////Dw8Ar/jIyMB//w
+ 8PAJ/wr/jIyMJ//39/f//////8XFxf+MjIz/t7e3///////T09P/jIyM/5qamhn/B/+hoaEK
+ /4yMjAf/aWlpEv8AAAAH/05OTg7/jIyMCf8O/4yMjAf/vr6+Ef8j//f39/+Tk5P/jIyM/+Li
+ 4v//////zMzM/4yMjP+vr68J/w//6enp/4yMjP+ampoJ/xf/4uLi/4yMjP+oqKj///////f3
+ 9wr/jIyMB//39/cV/w7/jIyMB/9OTk4S/wAAAAf/aWlpCv+MjIwP/6Ghof//////6enpDv+M
+ jIwH/8zMzBH/B//b29sa/4yMjBv/qKio/+np6f//////09PT/4yMjP+oqKgJ/w//4uLi/4yM
+ jP+oqKgJ/w//qKio/4yMjP/i4uIR/wf/6enpDv+MjIwH/z09PRL/AAAAB/+Dg4MK/4yMjA//
+ r6+v///////b29sO/4yMjAf/4uLiEf8H/8XFxSL/jIyME/+ampr/oaGh/4yMjP/FxcUJ/w//
+ 4uLi/4yMjP+oqKgJ/w//qKio/4yMjP/i4uIR/wf/29vbDv+MjIwH/yMjIw7/AAAAB/8ICAgO
+ /4yMjA//xcXF///////FxcUO/4yMjAf/9/f3Ef8P/6+vr/+MjIz/09PTCf8K/4yMjAv/t7e3
+ /5OTkw7/jIyMI/+hoaH/zMzM/+np6f/T09P/jIyM/6Ghof/T09P/t7e3Cv+MjIwH/+Li4hH/
+ B//FxcUO/4yMjAf/CAgIDv8AAAAH/yMjIw7/jIyMD//b29v//////6+vrwr/jIyMB/+Tk5MV
+ /w//qKio/4yMjP/i4uIJ/wr/jIyMCf8H/9PT0zL/jIyMB//p6ekR/wf/r6+vCv+MjIwH/4OD
+ gxL/AAAAB/89PT0O/4yMjA//6enp//////+hoaEK/4yMjAf/qKioFf8P/6+vr/+MjIz/zMzM
+ Cf8K/4yMjAn/B//39/cK/4yMjA//zMzM/6ioqP+Tk5MO/4yMjBP/qKio/6+vr/+MjIz/k5OT
+ Ff8H/6GhoQr/jIyMB/9paWkS/wAAAAf/Tk5ODv+MjIwL/8XFxf+oqKgO/4yMjAf/vr6+Ff8P
+ /8XFxf+MjIz/t7e3Cf8K/4yMjAn/D//i4uL/jIyM/6GhoQn/B//39/cK/4yMjBf/8PDw////
+ //++vr7/jIyM/7e3txX/Dv+MjIwH/05OThL/AAAAB/9paWki/4yMjAf/zMzMFf8P/+Li4v+M
+ jIz/k5OTCf8K/4yMjBf/8PDw///////MzMz/jIyM/6+vrwn/I//FxcX/jIyM/6ioqP//////
+ 8PDw/5OTk/+MjIz/4uLiEf8H/+np6Q7/jIyMB/89PT0S/wAAAAf/g4ODIv+MjIwH/+Li4hn/
+ N/+ampr/jIyM/8zMzP//////r6+v/4yMjP/MzMz//////76+vv+MjIz/xcXF///////p6ekK
+ /4yMjBf/4uLi//////+oqKj/jIyM/6ioqBX/B//b29sO/4yMjAf/IyMjEv8AAAAH/3p6ehL/
+ jIyMB/+Dg4MO/4yMjAf/9/f3Gf9T/9PT0/+MjIz/k5OT/+np6f/T09P/jIyM/5qamv//////
+ qKio/4yMjP/b29v/9/f3/5OTk/+MjIz/r6+v//////+3t7f/jIyM/5OTk//w8PAV/wf/xcXF
+ Dv+MjIwH/wgICBL/AAAAG/8RERH/RkZG/z09Pf8jIyP/AAAA/2BgYAr/jIyMB/+Tk5Mh/z//
+ qKio/4yMjP+Tk5P/6enp/5qamv+MjIz/vr6+/5OTk/+MjIz/29vb/5qamv+MjIz/oaGh//Dw
+ 8P+vr68K/4yMjAf/09PTGf8H/6+vrwr/jIyMB/+Dg4Mq/wAAAAf/cXFxCv+MjIwH/6ioqCH/
+ F//39/f/oaGh/4yMjP+Tk5P/oaGhEv+MjIwj/5OTk/+MjIz/mpqa/76+vv+Tk5P/jIyM/5OT
+ k//T09Md/wf/oaGhCv+MjIwH/2lpaSr/AAAADv+MjIwH/76+viX/C//39/f/qKioLv+MjIwL
+ /6Ghof/p6ekh/w7/jIyMB/9OTk4m/wAAAAf/GhoaDv+MjIwK/5qamhb/jIyMH/+ampr/qKio
+ /76+vv/T09P/8PDw/9PT0/+hoaEe/4yMjAv/oaGh/9PT0yX/B//p6ekO/4yMjAf/PT09Jv8A
+ AAAH/ysrKz7/jIyME/+ampr/vr6+/8zMzP/T09MO/8XFxQv/29vb//Dw8C3/B//MzMwO/4yM
+ jAf/IyMjJv8AAAAH/0ZGRkr/jIyMD/+Tk5P/t7e3/9vb2zH/C//39/f/vr6+Ev+MjIwH/wgI
+ CCb/AAAAB/8jIyMO/4yMjAv/enp6/2BgYBb/RkZGC/9paWn/cXFxJv+MjIwT/5OTk/+3t7f/
+ 09PT//Dw8Bn/D//39/f/zMzM/5qamhL/jIyMB/9paWku/wAAAA//Ghoa/yMjI/8ICAgm/wAA
+ ABP/CAgI/ysrK/9OTk7/enp6Jv+MjIwL/5qamv+oqKgK/8XFxQv/vr6+/6ioqBr/jIyMC/9p
+ aWn/CAgIbv8AAAAP/xEREf89PT3/cXFxQv+MjIwL/4ODg/9GRkaC/wAAAA//ERER/z09Pf9x
+ cXEy/4yMjAv/V1dX/xEREZL/AAAAF/8ICAj/Kysr/05OTv9paWn/cXFxDv+MjIwT/2lpaf9X
+ V1f/NDQ0/wgICONK/wAAAA==' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>mimeStringFor: (in category 'singleton management') -----
+ mimeStringFor: aForm
+ 
+ 	aForm hibernate.
+ 	^ (Base64MimeConverter mimeEncode: aForm bits readStream) contents.
+ !

Item was added:
+ ----- Method: SugarLibrary class>>miniPrivateIcon (in category 'icons') -----
+ miniPrivateIcon
+ 
+ 	^ Form extent: 36 at 36 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '5RA6/wAAAQv/ExMT/x4eHg7/ICAgC/8eHh7/ExMTav8AAAE3/x4eHv8gICD/MzMz/4mJif/K
+ ysr/3d3d/9/f3//d3d3/ysrK/4mJif8zMzP/ICAg/x0dHVb/AAABH/8eHh7/PT09/7a2tv/d
+ 3d3/39/f//Ly8v/9/f0N/x///f39//Ly8v/f39//3d3d/7a2tv89PT3/Hh4eRv8AAAEX/wgI
+ CP8+Pj7/ubm5/97e3v/9/f0t/xf//f39/97e3v+5ubn/Pj4+/wgICDr/AAABE/8eHh7/YGBg
+ /8fHx//9/f09/xP//f39/8fHx/9gYGD/Hh4eMv8AAAEP/ysrK/+Xl5f/3d3dTf8P/93d3f+X
+ l5f/LCwsKv8AAAEP/x4eHv+Xl5f/6+vrVf8P/+vr6/+YmJj/Hh4eIv8AAAEP/wgICP9gYGD/
+ 3d3dXf8P/93d3f9gYGD/CAgIHv8AAAEL/z4+Pv/Hx8dl/wv/x8fH/z4+Phr/AAABD/8eHh7/
+ ubm5//39/WX/D//9/f3/ubm5/x4eHhb/AAABC/89PT3/3t7ebf8L/93d3f89PT0S/wAAAQ//
+ HR0d/7a2tv/9/f1t/w///f39/7a2tv8eHh4O/wAAAQv/ICAg/93d3XX/C//d3d3/ICAgDv8A
+ AAEL/zMzM//f398x/wf//f39Dv/p6ekH//39/TH/C//f39//MzMzCv8AAAEP/xMTE/+JiYn/
+ 8vLyLf8f//Dw8P+Pj4//MTEx/x0dHf8xMTH/j4+P//Dw8C3/H//y8vL/iYmJ/xMTE/8AAAH/
+ Hh4e/8rKyv/9/f0p/w///f39/4+Pj/8iIiIO/wAAAQ//IiIi/4+Pj//9/f0p/xv//f39/8rK
+ yv8eHh7/AAAB/yAgIP/d3d0t/wv/6enp/zExMRb/AAABC/8xMTH/6enpLf8X/93d3f8gICD/
+ AAAB/yAgIP/f398t/wv/6enp/x0dHRb/AAABC/8dHR3/6enpLf8X/9/f3/8gICD/AAAB/yAg
+ IP/d3d0t/wv/6enp/zIyMhb/AAABC/8yMjL/6enpLf8b/93d3f8gICD/AAAB/x4eHv/Kysr/
+ /f39Lf8L/5iYmP8kJCQO/wAAAQv/JCQk/5iYmC3/H//9/f3/ysrK/x4eHv8AAAH/ExMT/4qK
+ iv/y8vIt/x//8vLy/4+Pj/8xMTH/HR0d/zExMf+Pj4//8vLyLf8P//Ly8v+JiYn/ExMTCv8A
+ AAEL/zMzM//f398x/wf//f39Dv/p6ekH//39/TH/C//f39//MzMzDv8AAAEL/yAgIP/d3d11
+ /wv/3d3d/yAgIA7/AAABD/8dHR3/tra2//39/W3/D//9/f3/tra2/x4eHhL/AAABC/89PT3/
+ 3t7ebf8L/97e3v89PT0W/wAAAQ//Hh4e/7m5uf/9/f1l/w///f39/7m5uf8eHh4a/wAAAQv/
+ Pj4+/8fHx2X/C//Hx8f/Pj4+Hv8AAAEP/wgICP9gYGD/3d3dXf8P/93d3f9gYGD/CAgIIv8A
+ AAEP/x4eHv+Xl5f/6+vrVf8P/+vr6/+Xl5f/Hh4eKv8AAAEP/ysrK/+Xl5f/3d3dTf8P/93d
+ 3f+Xl5f/KysrMv8AAAET/x4eHv9gYGD/x8fH//39/T3/E//9/f3/x8fH/2BgYP8eHh46/wAA
+ ARf/CAgI/z4+Pv+5ubn/3t7e//39/S3/F//9/f3/3t7e/7m5uf8+Pj7/CAgIRv8AAAEf/x4e
+ Hv89PT3/tra2/93d3f/f39//8vLy//39/Q3/H//9/f3/8vLy/9/f3//d3d3/tra2/z09Pf8e
+ Hh5W/wAAATf/Hh4e/yAgIP8zMzP/iYmJ/8rKyv/d3d3/39/f/93d3f/Kysr/iYmJ/zMzM/8g
+ ICD/Hh4eav8AAAEL/xMTE/8eHh4O/yAgIAv/Hh4e/xMTE87/AAAB' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>miniShareIcon (in category 'icons') -----
+ miniShareIcon
+ 
+ 	^ Form extent: 36 at 36 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '5RA6/wAAAQv/ExMT/x4eHg7/ICAgC/8eHh7/ExMTav8AAAE3/x4eHv8gICD/MzMz/4mJif/K
+ ysr/3d3d/9/f3//d3d3/ysrK/4mJif8zMzP/ICAg/x0dHVb/AAABH/8eHh7/PT09/7a2tv/d
+ 3d3/39/f//Ly8v/9/f0N/x///f39//Ly8v/f39//3d3d/7a2tv89PT3/Hh4eRv8AAAEX/wgI
+ CP8+Pj7/ubm5/97e3v/9/f0t/xf//f39/97e3v+5ubn/Pj4+/wgICDr/AAABE/8eHh7/YGBg
+ /8fHx//9/f0V/xf/6urq/3BwcP9SUlL/ioqK//39/RX/E//9/f3/x8fH/2BgYP8eHh4y/wAA
+ AQ//Kysr/5eXl//d3d0Z/xv/8fHx/1NTU/8CAgL/AQEB/wsLC/97e3sd/w//3d3d/5eXl/8s
+ LCwq/wAAAQ//Hh4e/5eXl//r6+sd/wf/1NTUEv8AAAEL/yEhIf/5+fkd/w//6+vr/5iYmP8e
+ Hh4i/wAAATf/CAgI/2BgYP/d3d3///////7+/v+9vb3/aGho/1tbW/+srKz/+Pj4///////c
+ 3Nz/DQ0NDv8AAAE3/zIyMv/+/v7///////7+/v/c3Nz/gICA/4iIiP/l5eX//v7+///////d
+ 3d3/YGBg/wgICB7/AAABC/8+Pj7/x8fHCf8L/9TU1P8xMTEK/wAAATf/Dw8P/7a2tv/9/f3/
+ /Pz8/4WFhf8HBwf/BQUF/xwcHP+qqqr///////7+/v/T09P/MzMzCv8AAAEL/0VFRf/U1NQJ
+ /wv/x8fH/z4+Phr/AAABD/8eHh7/ubm5//39/Qn/C/9zc3P/AwMDDv8AAAEf/4mJif/7+/v/
+ //////7+/v+oqKj/g4OD/729vQn/C//z8/P/dXV1Ev8AAAEH/5eXlwn/D//9/f3/ubm5/x4e
+ Hhb/AAABC/89PT3/3t7eDf8L/4qKiv8NDQ0K/wAAAQ//AgIC/5SUlP/7+/sd/w//8PDw/3Nz
+ c/8BAQEK/wAAAQv/AgIC/5aWlg3/C//d3d3/PT09Ev8AAAEP/x0dHf+2trb//f39Df8f/+/v
+ 7/9fX1//Dg4O/wsLC/8+Pj7/z8/P//7+/iH/G//BwcH/KSkp/wcHB/8JCQn/Nzc3/8nJyQ3/
+ D//9/f3/tra2/x4eHg7/AAABC/8gICD/3d3dFf8T//Ly8v+VlZX/ioqK/+Li4in/F//9/f3/
+ vb29/3Z2dv9+fn7/y8vLFf8L/93d3f8gICAO/wAAAQv/MzMz/9/f30H/B//+/v4x/wv/39/f
+ /zMzMwr/AAABD/8TExP/iYmJ//Ly8gn/E//m5ub/xMTE/8jIyP/x8fFF/xP/6enp/8TExP/H
+ x8f/7+/vCf87//Ly8v+JiYn/ExMT/wAAAf8eHh7/ysrK//39/f//////4eHh/15eXv8GBgb/
+ ERER/39/f//u7u49/zf/3d3d/2RkZP8HBwf/Dg4O/3x8fP/v7+////////39/f/Kysr/Hh4e
+ /wAAAf8gICD/3d3dCf8H/35+fg7/AAABD/8FBQX/s7Oz//39/TX/C//5+fn/gYGBDv8AAAEL
+ /wcHB/+xsbEJ/xf/3d3d/yAgIP8AAAH/ICAg/9/f3wn/B/9gYGAS/wAAAQv/lpaW//r6+jX/
+ C//x8fH/Xl5eEv8AAAEH/5ubmwn/F//f39//ICAg/wAAAf8gICD/3d3dCf8L/5eXl/8MDAwK
+ /wAAAQ//Gxsb/8HBwf/+/v41/w//+/v7/5mZmf8NDQ0K/wAAAQv/Ghoa/8HBwQn/N//d3d3/
+ ICAg/wAAAf8eHh7/ysrK//39/f//////7e3t/4iIiP9AQED/R0dH/6enp//4+Pg9/zv/7+/v
+ /46Ojv9BQUH/RERE/6Ojo//29vb///////39/f/Kysr/Hh4e/wAAAf8TExP/ioqK//Ly8gn/
+ D//39/f/2dnZ/9/f30n/E//6+vr/2tra/9zc3P/+/v4J/w//8vLy/4mJif8TExMK/wAAAQv/
+ MzMz/9/f33X/C//f39//MzMzDv8AAAEL/yAgIP/d3d0R/xv/9PT0/5GRkf9VVVX/V1dX/7W1
+ tf/9/f0l/xf/9vb2/6Wlpf9YWFj/f39//+Tk5BX/C//d3d3/ICAgDv8AAAEP/x0dHf+2trb/
+ /f39Df8L/5KSkv8SEhIK/wAAAQ//ISEh/8nJyf/+/v4d/x//9/f3/5ycnP8WFhb/AAAB/wYG
+ Bv9iYmL/6urqDf8P//39/f+2trb/Hh4eEv8AAAEL/z09Pf/e3t4N/wf/WFhYEv8AAAEL/5OT
+ k//7+/sd/wv/7e3t/2VlZQ7/AAABC/8NDQ3/q6urDf8L/97e3v89PT0W/wAAAQ//Hh4e/7m5
+ uf/9/f0J/wf/ZmZmEv8AAAEf/7CwsP/9/f3//////+zs7P9ycnL/T09P/46Ojgn/C//t7e3/
+ YmJiDv8AAAEL/xEREf+wsLAJ/w///f39/7m5uf8eHh4a/wAAAQv/Pj4+/8fHxwn/R//X19f/
+ Wlpa/wAAAf8KCgr/goKC//Dw8P//////8/Pz/1dXV/8HBwf/AAAB/xISEv+EhIT///////39
+ /f+tra3/ERERCv8AAAEL/29vb//19fUJ/wv/x8fH/z4+Ph7/AAABJ/8ICAj/YGBg/93d3f//
+ /////v7+/+rq6v+4uLj/yMjI//Pz8wn/C//Z2dn/BAQEDv8AAAEj/yYmJv/7+/v///////X1
+ 9f/Hx8f/pqam/7e3t//n5+cJ/w//3d3d/2BgYP8ICAgi/wAAAQ//Hh4e/5eXl//r6+sJ/wv/
+ /f39//7+/g3/C//Y2Nj/AwMDDv8AAAEH/ycnJw3/D//+/v7/+/v7//39/Qn/D//r6+v/l5eX
+ /x4eHir/AAABD/8rKyv/l5eX/93d3Rn/C//4+Pj/e3t7Cv8AAAEL/w4ODv+ioqId/w//3d3d
+ /5eXl/8rKysy/wAAARP/Hh4e/2BgYP/Hx8f//f39Ff8X//n5+f+0tLT/oqKi/8PDw//9/f0V
+ /xP//f39/8fHx/9gYGD/Hh4eOv8AAAEX/wgICP8+Pj7/ubm5/97e3v/9/f0t/xf//f39/97e
+ 3v+5ubn/Pj4+/wgICEb/AAABH/8eHh7/PT09/7a2tv/d3d3/39/f//Ly8v/9/f0N/x///f39
+ //Ly8v/f39//3d3d/7a2tv89PT3/Hh4eVv8AAAE3/x4eHv8gICD/MzMz/4mJif/Kysr/3d3d
+ /9/f3//d3d3/ysrK/4mJif8zMzP/ICAg/x4eHmr/AAABC/8TExP/Hh4eDv8gICAL/x4eHv8T
+ ExPO/wAAAQ==' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>newDefault (in category 'singleton management') -----
+ newDefault
+ 	"Answer a new instance of SugarLibrary."
+ 
+ 	| i |
+ 	i := SugarLibrary new.
+ 	i iconAt: 'new' put: self newIcon.
+ 	i iconAt: 'prev' put: self prevIcon.
+ 	i iconAt: 'next' put: self nextIcon.
+ 	i iconAt: 'save' put: self saveIcon.
+ 	i iconAt: 'open' put: self openIcon.
+ 	i iconAt: 'keep' put: self keepIcon.
+ 	i iconAt: 'choose' put: self chooseIcon.
+ 	i iconAt: 'paint' put: self paintIcon.
+ 	i iconAt: 'language' put: self languageIcon.
+ 	i iconAt: 'undo' put: self undoIcon.
+ 	i iconAt: 'close' put: self closeIcon.
+ 	i iconAt: 'share' put: self shareIcon.
+ 	i iconAt: 'miniShare' put: self miniShareIcon.
+ 	i iconAt: 'supplies' put: self suppliesIcon.
+ 	i iconAt: 'stop' put: self stopIcon.
+ 	i iconAt: 'zoom' put: self zoomIcon.
+ 	i iconAt: 'help' put: self helpIcon.
+ 	i iconAt: 'miniPrivate' put: self miniPrivateIcon.
+ 	i iconAt: 'private' put: self privateIcon.
+ 	i iconAt: 'hideNavBar' put: self hideNavBarIcon.
+ 	i iconAt: 'showNavBar' put: self showNavBarIcon.
+ 
+ 	i iconAt: 'newProject' put: (i iconAt: 'new').
+ 	i iconAt: 'previousProject' put: (i iconAt: 'prev').
+ 	i iconAt: 'nextProject' put: (i iconAt: 'next').
+ 	i iconAt: 'publishProject' put: (i iconAt: 'save').
+ 	i iconAt: 'findAProjectSimple' put: (i iconAt: 'open').
+ 	i iconAt: 'keepProject' put: (i iconAt: 'keep').
+ 	i iconAt: 'chooseObject' put: (i iconAt: 'choose').
+ 	i iconAt: 'doNewPainting' put: (i iconAt: 'paint').
+ 	i iconAt: 'chooseLanguage' put: (i iconAt: 'language').
+ 	i iconAt: 'undoOrRedoLastCommand' put: (i iconAt: 'undo').
+ 	i iconAt: 'toggleSupplies' put: (i iconAt: 'supplies').
+ 	i iconAt: 'quitSqueak' put: (i iconAt: 'close').
+ 	i iconAt: 'shareThisWorld' put: (i iconAt: 'share').
+ 	i iconAt: 'shareMenu' put: (i iconAt: 'private').
+ 	i iconAt: 'chooseScreenSetting' put: (i iconAt: 'zoom').
+ 	i iconAt: 'stopSqueak' put: (i iconAt: 'stop').
+ 	i iconAt: 'toggleHelp' put: (i iconAt: 'help'). 
+ 
+ 	i iconAt: 'missingIcon' put: (i iconAt: 'private'). 
+ 
+ 	^  i
+ !

Item was added:
+ ----- Method: SugarLibrary class>>newIcon (in category 'icons') -----
+ newIcon
+ 
+ 	^ Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '6cTh2v8AAAAH/xoaGl7/aWlpB/80NDRi/wAAAAv/Ghoa/4ODg17/jIyMB/9GRkZe/wAAAAv/
+ Ghoa/4ODg2L/jIyMB/9GRkZa/wAAAAv/Ghoa/4ODgxL/jIyMB/+amppG/6ioqA7/jIyMB/9G
+ RkZW/wAAAAv/Ghoa/4ODgxb/jIyMB//FxcVF/w7/jIyMB/9GRkZS/wAAAAv/Ghoa/4ODgxr/
+ jIyMB//FxcVF/w7/jIyMB/9GRkZO/wAAAAv/Ghoa/4ODgw7/jIyMB/+hoaEO/4yMjAf/xcXF
+ Rf8O/4yMjAf/RkZGSv8AAAAL/xoaGv+Dg4MO/4yMjAv/oaGh//f39w7/jIyMB//FxcVF/w7/
+ jIyMB/9GRkZG/wAAAAv/Ghoa/4ODgw7/jIyMD/+hoaH/9/f3/////w7/jIyMB//FxcVF/w7/
+ jIyMB/9GRkZC/wAAAAv/Ghoa/4ODgw7/jIyMC/+hoaH/9/f3Cf8O/4yMjAf/xcXFRf8O/4yM
+ jAf/RkZGPv8AAAAL/xoaGv+Dg4MO/4yMjAv/oaGh//f39w3/Dv+MjIwH/8XFxUX/Dv+MjIwH
+ /0ZGRjr/AAAAC/8aGhr/g4ODDv+MjIwL/6Ghof/39/cR/w7/jIyMB//FxcVF/w7/jIyMB/9G
+ RkY2/wAAAAv/Ghoa/4ODgxL/jIyMB/+hoaEW/6ioqA7/jIyMB//FxcVF/w7/jIyMB/9GRkY2
+ /wAAAAf/aWlpOv+MjIwH/8XFxUX/Dv+MjIwH/0ZGRjb/AAAAB/9paWk6/4yMjAf/xcXFRf8O
+ /4yMjAf/RkZGNv8AAAAH/2lpaQr/jIyMB/+Tk5Mu/6ioqAf/09PTRf8O/4yMjAf/RkZGNv8A
+ AAAH/2lpaQr/jIyMB/+oqKh1/w7/jIyMB/9GRkY2/wAAAAf/aWlpCv+MjIwH/6ioqHX/Dv+M
+ jIwH/0ZGRjb/AAAAB/9paWkK/4yMjAf/qKiodf8O/4yMjAf/RkZGNv8AAAAH/2lpaQr/jIyM
+ B/+oqKh1/w7/jIyMB/9GRkY2/wAAAAf/aWlpCv+MjIwH/6ioqHX/Dv+MjIwH/0ZGRjb/AAAA
+ B/9paWkK/4yMjAf/qKiodf8O/4yMjAf/RkZGNv8AAAAH/2lpaQr/jIyMB/+oqKh1/w7/jIyM
+ B/9GRkY2/wAAAAf/aWlpCv+MjIwH/6ioqHX/Dv+MjIwH/0ZGRjb/AAAAB/9paWkK/4yMjAf/
+ qKiodf8O/4yMjAf/RkZGNv8AAAAH/2lpaQr/jIyMB/+oqKh1/w7/jIyMB/9GRkY2/wAAAAf/
+ aWlpCv+MjIwH/6ioqHX/Dv+MjIwH/0ZGRjb/AAAAB/9paWkK/4yMjAf/qKiodf8O/4yMjAf/
+ RkZGNv8AAAAH/2lpaQr/jIyMB/+oqKh1/w7/jIyMB/9GRkY2/wAAAAf/aWlpCv+MjIwH/6io
+ qHX/Dv+MjIwH/0ZGRjb/AAAAB/9paWkK/4yMjAf/qKiodf8O/4yMjAf/RkZGNv8AAAAH/2lp
+ aQr/jIyMB/+oqKh1/w7/jIyMB/9GRkY2/wAAAAf/aWlpCv+MjIwH/6ioqHX/Dv+MjIwH/0ZG
+ Rjb/AAAAB/9paWkK/4yMjAf/qKiodf8O/4yMjAf/RkZGNv8AAAAH/2lpaQr/jIyMB/+oqKh1
+ /w7/jIyMB/9GRkY2/wAAAAf/aWlpCv+MjIwH/6ioqHX/Dv+MjIwH/0ZGRjb/AAAAB/9paWkK
+ /4yMjAf/qKiodf8O/4yMjAf/RkZGNv8AAAAH/2lpaQr/jIyMB/+oqKh1/w7/jIyMB/9GRkY2
+ /wAAAAf/aWlpCv+MjIwH/6ioqHX/Dv+MjIwH/0ZGRjb/AAAAB/9paWkK/4yMjAf/qKiodf8O
+ /4yMjAf/RkZGNv8AAAAH/2lpaQr/jIyMB/+oqKh1/w7/jIyMB/9GRkY2/wAAAAf/aWlpCv+M
+ jIwH/6ioqHX/Dv+MjIwH/0ZGRjb/AAAAB/9paWkK/4yMjAf/qKiodf8O/4yMjAf/RkZGNv8A
+ AAAH/2lpaQr/jIyMB/+Tk5N2/6ioqA7/jIyMB/9GRkY2/wAAAAf/aWlpjv+MjIwH/0ZGRjb/
+ AAAAB/9paWmO/4yMjAf/RkZGNv8AAAAH/05OTo7/aWlpB/80NDTg5v8AAAA=' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>nextIcon (in category 'icons') -----
+ nextIcon
+ 
+ 	^ Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '6cTiXv8AAAAH/z8/P2n/E/+/v7//n5+f/19fX/8PDw9O/wAAAAf/Pz8/ef8L/6+vr/9fX19G
+ /wAAAAf/Pz8/gf8L/9/f3/9fX18+/wAAAAf/Pz8/if8L/7+/v/8vLy82/wAAAAf/Pz8/jf8L
+ /+/v7/9fX18y/wAAAAf/Pz8/lf8H/5+fny7/AAAAB/8/Pz+Z/wf/n5+fKv8AAAAH/z8/P53/
+ B/+fn58m/wAAAAf/Pz8/of8H/19fXyL/AAAAB/8/Pz+h/wv/7+/v/y8vLx7/AAAAB/8/Pz+l
+ /wf/z8/PHv8AAAAH/z8/P6n/B/9fX18a/wAAAAf/Pz8/Pf8L/7y8vP/d3d1l/wf/39/fGv8A
+ AAAH/z8/Pz3/D/+mpqb/TU1N/6ampmX/B/9fX18W/wAAAAf/Pz8/Pf8H/6ampgr/TU1NC/9u
+ bm7/3d3dXf8H/8/Pzxb/AAAAB/8/Pz89/wf/pqamEv9NTU0H/7GxsV3/B/8fHx8S/wAAAAf/
+ Pz8/Pf8H/6amphb/TU1NC/95eXn/6OjoVf8H/29vbxL/AAAAB/8/Pz89/wf/pqamGv9NTU0L
+ /1hYWP+8vLxR/wf/r6+vEv8AAAAH/z8/Pz3/B/+mpqYi/01NTQv/hISE//Pz80n/B//f398S
+ /wAAAAf/Pz8/Pf8H/6ampib/TU1NC/9YWFj/x8fHSf8S/wAAAAf/Pz8/Pf8H/6ampi7/TU1N
+ C/+Pj4//8/PzQf8H/w8PDw7/AAAAB/8/Pz89/wf/pqamMv9NTU0L/2NjY//S0tI9/wf/Pz8/
+ Dv8AAAAH/z8/Pz3/B/+mpqY6/01NTQf/mpqaOf8H/z8/Pw7/AAAAB/8/Pz89/wf/pqamNv9N
+ TU0L/1hYWP/S0tI5/wf/Pz8/Dv8AAAAH/z8/Pz3/B/+mpqYy/01NTQv/hISE//Pz8z3/B/8P
+ Dw8O/wAAAAf/Pz8/Pf8H/6ampir/TU1NC/9YWFj/x8fHRf8S/wAAAAf/Pz8/Pf8H/6ampib/
+ TU1NC/95eXn/6OjoRf8H/9/f3xL/AAAAB/8/Pz89/wf/pqamHv9NTU0L/1hYWP+xsbFN/wf/
+ r6+vEv8AAAAH/z8/Pz3/B/+mpqYa/01NTQv/bm5u/+jo6FH/B/9vb28S/wAAAAf/Pz8/Pf8H
+ /6amphb/TU1NB/+mpqZZ/wf/Hx8fEv8AAAAH/z8/Pz3/B/+mpqYO/01NTQv/bm5u/93d3Vn/
+ B//Pz88W/wAAAAf/Pz8/Pf8H/6ampgr/TU1NC/+ampr/8/PzXf8H/19fXxb/AAAAB/8/Pz89
+ /w//pqam/2NjY//S0tJh/wf/39/fGv8AAAAH/z8/Pz3/C//S0tL/8/PzZf8H/19fXxr/AAAA
+ B/8/Pz+l/wf/z8/PHv8AAAAH/z8/P6H/C//v7+//Ly8vHv8AAAAH/z8/P6H/B/9fX18i/wAA
+ AAf/Pz8/nf8H/5+fnyb/AAAAB/8/Pz+Z/wf/n5+fKv8AAAAH/z8/P5X/B/+fn58u/wAAAAf/
+ Pz8/jf8L/+/v7/9fX18y/wAAAAf/Pz8/if8L/7+/v/8vLy82/wAAAAf/Pz8/gf8L/9/f3/9f
+ X18+/wAAAAf/Pz8/ef8L/6+vr/9fX19G/wAAAAf/Pz8/af8T/7+/v/+fn5//X19f/w8PD+Ha
+ /wAAAA==' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>openIcon (in category 'icons') -----
+ openIcon
+ 
+ 	^ Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '6cThZv8AAAAv/xISEv8zMzP/SUlJ/19fX/91dXX/ioqK/6CgoP+2trb/zMzM/66urv8aGhqa
+ /wAAAAv/UFBQ//X19SX/B/94eHia/wAAAAf/jo6OKf8H/35+fpr/AAAAG/8SEhL/oKCg/6Gh
+ of+MjIz/d3d3/7m5uRX/B/9oaGiq/wAAAAf/fHx8Gf8H/1JSUqL/AAAAC/8BAQH/ampqCf8P
+ //7+/v//////8fHxCf8H/zw8PKL/AAAAK/9aWlr//v7+///////+/v7//////+Tk5P+6urr/
+ //////7+/v8nJyee/wAAAAv/SkpK//39/Q3/D//r6+v/DAwM/83NzQn/B/8RERGa/wAAAAv/
+ Ojo6//z8/A3/G//x8fH/FBQU/wAAAP/i4uL///////r6+pr/AAAAC/8fHx//+vr6Df8L//b2
+ 9v8dHR0K/wAAAA//9/f3///////m5uaa/wAAAAv/oqKi//7+/gn/C//5+fn/KCgoDv8AAAAP
+ /8PDw///////qampgv8AAAAH/wEBARb/AAAAB/+Ojo4J/wv/+/v7/zc3NxL/AAAAD/8RERH/
+ TExM/wQEBDr/AAAAB/8BAQEy/wAAAAf/AQEBLv8AAAAP/5iYmP++vr7/MTEx0v8AAAAH/wEB
+ ATr/AAAAD/8gICD/bm5u/5SUlBr/qKioE/+kpKT/hISE/1NTU/8JCQmS/wAAAAv/QEBA/6qq
+ qg7/ra2tB/+srKwW/62trRP/rKys/66urv+QkJD/EBAQNv8AAAAH/wEBAVL/AAAAE/8YGBj/
+ qamp/62trf+urq4K/62trQf/rq6uIv+tra0H/3l5eTL/AAAAB/8BAQEO/wAAAAf/AQEBRv8A
+ AAAH/25ubg7/ra2tC/+/v7//0tLSFv/T09Mb/83Nzf+zs7P/rq6u/62trf+urq7/GxsbKv8A
+ AAAH/wEBAVL/AAAAD/8BAQH/AAAA/5mZmQr/ra2tB/+/v78h/wf/7OzsDv+tra0P/6qqqv+o
+ qKj/qampFv+oqKgO/6mpqRf/qKio/6Ojo/+CgoL/SEhI/wEBAUb/AAAAB/8HBwcO/62trQf/
+ 2NjYIf8H//7+/kr/ra2tC/+CgoL/CQkJQv8AAAAH/wsLCw7/ra2tB//c3Nwl/w//y8vL/62t
+ rf+srKxC/62trQf/c3NzQv8AAAAH/wsLCw7/ra2tB//b29sl/wv/+vr6/9vb2w7/09PTC//S
+ 0tL/1NTUIv/T09Mb/8zMzP+vr6//ra2t/66urv+tra3/IyMjIv8AAAAH/wEBARr/AAAAB/8L
+ CwsO/62trQf/29vbMf8H//7+/in/D//+/v7//////+rq6g7/ra2tB/9TU1M+/wAAAAf/CwsL
+ Dv+tra0H/9zc3Gn/B/+0tLQK/62trQf/ZmZmEv8AAAAH/wEBASr/AAAAB/8KCgoO/62trQf/
+ 29vbUf8H//7+/hX/B/+1tbUK/62trQf/ZmZmPv8AAAAH/wsLCw7/ra2tB//b29sN/xf/+Pj4
+ /9bW1v/FxcX/v7+//76+vgr/v7+/D/++vr7/v7+//8DAwBb/v7+/B/++vr4e/7+/vwf/sLCw
+ Cv+tra0b/5mZmf+IiIj/h4eH/3R0dP9JSUn/BQUFKv8AAAAH/wsLCw7/ra2tB//b29sJ/wv/
+ 5eXl/7Kysgr/ra2tB/+urq4K/62trQf/rKysLv+tra0H/66urg7/ra2tB/+urq4i/62trQv/
+ kpKS/xISEib/AAAAB/8LCwsO/62trRP/29vb///////y8vL/sLCwev+tra0X/6ysrP+tra3/
+ e3t7/wAAAP8BAQEe/wAAAAf/CwsLDv+tra0f/9ra2v/+/v7/vr6+/62trf+urq7/ra2t/7e3
+ t1b/xMTEB//Dw8MO/8TExAv/w8PD/7Ozsw7/ra2tB/8SEhIi/wAAAAf/CwsLDv+tra0L/9vb
+ 2//c3NwO/62trQv/wsLC//7+/mn/B//j4+MO/62trQf/ISEhHv8AAAAP/wEBAf8LCwv/rKys
+ Cv+tra0L/9vb2/+9vb0K/62trQv/sbGx//X19W3/B//U1NQO/62trQf/GhoaIv8AAAAH/wsL
+ Cw7/ra2tB//X19cK/62trQv/rKys/9HR0W3/C//8/Pz/s7OzCv+tra0L/5SUlP8BAQEi/wAA
+ AAf/CwsLDv+tra0H/8nJyQ7/ra2tB//q6upt/wf/3d3dDv+tra0H/0dHRyb/AAAAB/8LCwsO
+ /62trQf/u7u7Cv+tra0L/7Gxsf/9/f1Z/wf//v7+Df8L//7+/v+5ubkK/62trQv/oKCg/wcH
+ Byb/AAAAB/8LCwsO/62trQf/r6+vCv+tra0H/8nJyRn/B//+/v5R/wf/5ubmDv+tra0H/1pa
+ Wir/AAAAB/8LCwsa/62trQf/4eHhbf8H/8DAwAr/ra2tE/+oqKj/EBAQ/wAAAP8BAQEi/wAA
+ AAf/CwsLFv+tra0L/66urv/6+vpp/wf/7u7uDv+tra0H/2pqai7/AAAAB/8LCwsS/62trQv/
+ rq6u/8DAwA3/B//+/v5d/xf/ycnJ/66urv+tra3/rq6u/x4eHi7/AAAAB/8LCwsW/62trQf/
+ 2NjYaf8L//X19f+urq4K/62trQf/fX19Mv8AAAAH/wsLCwr/ra2tB/+srKwK/62trQf/8fHx
+ af8H/9HR0Q7/ra2tB/8vLy8y/wAAAAf/CwsLEv+tra0H/7e3t2n/C//6+vr/sbGxCv+tra0H
+ /46Ojjb/AAAAC/8LCwv/rq6uDv+tra0H/8/Pz2n/B//a2toK/62trQv/rq6u/0BAQBr/AAAA
+ B/8BAQEa/wAAAAf/CwsLEv+tra0H/+jo6Gn/B/+2trYK/62trQv/nJyc/wQEBDb/AAAAB/8L
+ CwsS/62trQf/x8fHZv/JyckH/8TExA7/ra2tB/9TU1M6/wAAAAf/CwsLev+tra0H/66urgr/
+ ra2tC/+mpqb/DAwMOv8AAAAL/wEBAf+qqqp2/62trQf/rKysCv+tra0H/2RkZD7/AAAAE/8B
+ AQH/S0tL/6CgoP+fn59y/5OTkw//kZGR/11dXf8LCwvhuv8AAAA=' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>paintIcon (in category 'icons') -----
+ paintIcon
+ 
+ 	^ Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '6cThYv8AAAAL/xEREf9XV1cK/2lpaQf/RkZGsv8AAAAL/zQ0NP+Dg4MS/4yMjAf/Tk5Oqv8A
+ AAAH/1dXVx7/jIyMpv8AAAAH/1dXVxL/jIyMB/+Tk5MO/4yMjAf/IyMjnv8AAAAH/z09PRL/
+ jIyMC/+3t7f/zMzMDv+MjIwH/xoaGpr/AAAAB/8jIyMS/4yMjA//t7e3//////+3t7cO/4yM
+ jJr/AAAAC/8ICAj/enp6Dv+MjIwH/7e3twn/B/+ampoK/4yMjAf/cXFxmv8AAAAH/05OTg7/
+ jIyMB/+oqKgJ/wf/4uLiDv+MjIwH/05OTpb/AAAAB/8REREO/4yMjAv/k5OT//f39wn/B/+v
+ r68O/4yMjAf/Ghoalv8AAAAH/1dXVw7/jIyMB//MzMwJ/wf/8PDwDv+MjIwH/2lpaZb/AAAA
+ B/8REREO/4yMjAf/mpqaDf8H/6ioqA7/jIyMB/80NDRW/wAAAAv/IyMj/zQ0NBb/RkZGC/8r
+ Kyv/GhoaHv8AAAAH/1dXVw7/jIyMB//T09MJ/wf/4uLiDv+MjIwH/3p6ek7/AAAAC/80NDT/
+ YGBgLv+MjIwP/2BgYP89PT3/CAgICv8AAAAH/xEREQ7/jIyMB/+ampoJ/wv/9/f3/5qamg7/
+ jIyMB/8jIyNG/wAAAAv/NDQ0/3p6ekL/jIyMD/9gYGD/IyMj/1dXVw7/jIyMB//T09MJ/wf/
+ r6+vDv+MjIwH/2BgYEL/AAAAC/8ICAj/aWlpXv+MjIwH/5qamgn/B//T09MO/4yMjAv/g4OD
+ /xERET7/AAAAC/8aGhr/g4ODFv+MjIwP/6+vr//MzMz/4uLiEf8T//f39//i4uL/zMzM/6+v
+ ryL/jIyME//T09P//////+np6f+Tk5MO/4yMjAf/KysrPv8AAAAL/xoaGv+Dg4MS/4yMjAv/
+ t7e3//Dw8C3/D//39/f/09PT/6ioqBL/jIyME/+ampr///////f39/+hoaEO/4yMjAf/V1dX
+ Pv8AAAAL/wgICP9xcXEO/4yMjAv/k5OT/+Li4kH/B/+3t7cO/4yMjA//09PT//////+3t7cO
+ /4yMjAv/cXFx/wgICD7/AAAAB/9OTk4O/4yMjAv/oaGh//f390H/C//39/f/k5OTCv+MjIwP
+ /5OTk//39/f/09PTEv+MjIwH/zQ0ND7/AAAAB/8REREO/4yMjAv/k5OT/+np6UX/B//FxcUO
+ /4yMjAv/xcXF/+np6Rb/jIyMC/+Dg4P/NDQ0Ov8AAAAH/1dXVw7/jIyMB//MzMxF/wv/29vb
+ /5OTkw7/jIyMC//p6en/k5OTHv+MjIwH/0ZGRjb/AAAAB/+Dg4MK/4yMjAf/mpqaRf8H/8XF
+ xSb/jIyMCv+hoaES/4yMjAf/V1dXLv8AAAAH/yMjIw7/jIyMB//MzMxB/wf/t7e3Jv+MjIwT
+ /5OTk//w8PD/9/f3/7e3txL/jIyMB/9XV1cq/wAAAAf/RkZGDv+MjIwH//Dw8D3/B//T09MS
+ /4yMjAv/qKio/5OTkxL/jIyMB//i4uIN/wf/t7e3Ev+MjIwH/0ZGRib/AAAAB/9GRkYO/4yM
+ jD3/C//39/f/k5OTDv+MjIwP/7e3t///////6enpDv+MjIwH/7e3txX/B//T09MS/4yMjAf/
+ NDQ0Iv8AAAAH/2lpaQr/jIyMB/+hoaE9/wf/zMzMDv+MjIwH/7e3twn/B//MzMwO/4yMjAf/
+ 29vbGf8H/7e3tw7/jIyMC/+Dg4P/GhoaHv8AAAAH/05OTg7/jIyMPf8H/6GhoQr/jIyMC/+T
+ k5P/9/f3Cf8H/5qamgr/jIyMB/+Tk5Mh/wf/t7e3Dv+MjIwH/3FxcR7/AAAAB/9GRkYO/4yM
+ jAf/9/f3Nf8H//f39w7/jIyMB/+3t7cJ/wf/4uLiDv+MjIwH/7e3tyH/C//39/f/oaGhDv+M
+ jIwH/z09PRr/AAAAB/8rKysO/4yMjAf/29vbNf8H/9vb2w7/jIyME//T09P///////f39/+a
+ mpoO/4yMjAf/6enpJf8H/+np6Q7/jIyMC/+Dg4P/CAgIFv8AAAAH/xEREQ7/jIyMB/+3t7c1
+ /wf/t7e3Dv+MjIwP//Dw8P/T09P/k5OTDv+MjIwH/6ioqC3/B//FxcUO/4yMjAf/RkZGGv8A
+ AAAH/3FxcQ7/jIyMB//w8PAt/wv/9/f3/5OTkwr/jIyMC/+Tk5P/mpqaEv+MjIwL/5OTk//w
+ 8PAR/wf/29vbCv/FxcUL/8zMzP/39/cJ/wv/9/f3/5OTkwr/jIyMC/+Dg4P/CAgIFv8AAAAH
+ /zQ0NA7/jIyMB/+oqKgt/wf/t7e3Iv+MjIwL/5qamv/p6ekN/wv/9/f3/6ioqBL/jIyMC/+T
+ k5P/09PTCf8H/8XFxQ7/jIyMB/80NDQa/wAAAAf/enp6Dv+MjIwH/8zMzCX/B//T09Mi/4yM
+ jAv/vr6+//f39xH/B/+hoaEe/4yMjA//4uLi///////39/cO/4yMjAf/YGBgGv8AAAAH/yMj
+ IxL/jIyMB//T09Mh/wf/qKioGv+MjIwL/7e3t//w8PAV/wf/09PTIv+MjIwH/6GhoQn/B/+v
+ r68O/4yMjAf/CAgIGv8AAAAH/05OThL/jIyMB//FxcUd/wf/zMzMDv+MjIwP/5OTk/++vr7/
+ 8PDwHf8H/7e3tw7/jIyMD/8jIyP/CAgI/2lpaQ7/jIyMCf8H/9PT0w7/jIyMB/8jIyMe/wAA
+ AAf/V1dXEv+MjIwL/6Ghof/i4uIZ/w//09PT/8XFxf/b29sp/wf/qKioCv+MjIwH/3FxcQr/
+ AAAAB/9GRkYO/4yMjAn/B//w8PAO/4yMjAf/RkZGIv8AAAAH/1dXVxb/jIyMD/+oqKj/09PT
+ //f390H/B/++vr4O/4yMjA//Tk5O/ysrK/+Dg4MO/4yMjA3/Dv+MjIwH/0ZGRib/AAAAB/9G
+ RkYe/4yMjAf/mpqaEv+oqKgT/76+vv/FxcX/09PT/+np6R3/B//i4uIi/4yMjAf/t7e3Df8O
+ /4yMjAf/aWlpKv8AAAAL/xoaGv9paWk+/4yMjA//qKio/8XFxf/p6ekR/wf/t7e3Gv+MjIwL
+ /5OTk//w8PAN/w7/jIyMB/9OTk4y/wAAAAv/IyMj/2BgYEL/jIyMD/+ampr/vr6+/+np6Qn/
+ C//FxcX/k5OTDv+MjIwL/6ioqP/w8PAN/wf/6enpDv+MjIwH/0ZGRjr/AAAAD/8ICAj/Kysr
+ /0ZGRhb/aWlpLv+MjIwL/6ioqP/T09MJ/wr/4uLiB//w8PAV/wf/t7e3Dv+MjIwH/xoaGmL/
+ AAAAE/8jIyP/PT09/1dXV/96enoe/4yMjAv/mpqa/9vb2x3/B//T09MO/4yMjAf/enp6dv8A
+ AAAP/xoaGv9OTk7/enp6Gv+MjIwL/6ioqP/p6ekN/wv/9/f3/76+vhL/jIyMB/8rKyuC/wAA
+ AAv/IyMj/2BgYBr/jIyMB/+hoaEK/6ioqBb/jIyMB/9XV1eO/wAAAAv/ERER/1dXVy7/jIyM
+ C/9gYGD/CAgIlv8AAAAL/yMjI/9xcXEe/4yMjAv/g4OD/z09Pab/AAAAC/8rKyv/V1dXDv9p
+ aWkP/2BgYP80NDT/CAgI4ar/AAAA' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>prevIcon (in category 'icons') -----
+ prevIcon
+ 
+ 	^ Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '6cTiov8AAAAT/w8PD/9fX1//n5+f/7+/v2n/B/8/Pz9G/wAAAAv/X19f/6+vr3n/B/8/Pz8+
+ /wAAAAv/X19f/9/f34H/B/8/Pz82/wAAAAv/Ly8v/7+/v4n/B/8/Pz8y/wAAAAv/X19f/+/v
+ 743/B/8/Pz8u/wAAAAf/n5+flf8H/z8/Pyr/AAAAB/+fn5+Z/wf/Pz8/Jv8AAAAH/5+fn53/
+ B/8/Pz8i/wAAAAf/X19fof8H/z8/Px7/AAAAC/8vLy//7+/vof8H/z8/Px7/AAAAB//Pz8+l
+ /wf/Pz8/Gv8AAAAH/19fX6n/B/8/Pz8a/wAAAAf/39/fZf8L/93d3f+8vLw9/wf/Pz8/Fv8A
+ AAAH/19fX2X/D/+mpqb/TU1N/6ampj3/B/8/Pz8W/wAAAAf/z8/PXf8L/93d3f9ubm4K/01N
+ TQf/pqamPf8H/z8/PxL/AAAAB/8fHx9d/wf/sbGxEv9NTU0H/6ampj3/B/8/Pz8S/wAAAAf/
+ b29vVf8L/+jo6P95eXkW/01NTQf/pqamPf8H/z8/PxL/AAAAB/+vr69R/wv/vLy8/1hYWBr/
+ TU1NB/+mpqY9/wf/Pz8/Ev8AAAAH/9/f30n/C//z8/P/hISEIv9NTU0H/6ampj3/B/8/Pz8S
+ /wAAAEn/C//Hx8f/WFhYJv9NTU0H/6ampj3/B/8/Pz8O/wAAAAf/Dw8PQf8L//Pz8/+Pj48u
+ /01NTQf/pqamPf8H/z8/Pw7/AAAAB/8/Pz89/wv/0tLS/2NjYzL/TU1NB/+mpqY9/wf/Pz8/
+ Dv8AAAAH/z8/Pzn/B/+ampo6/01NTQf/pqamPf8H/z8/Pw7/AAAAB/8/Pz85/wv/0tLS/1hY
+ WDb/TU1NB/+mpqY9/wf/Pz8/Dv8AAAAH/w8PDz3/C//z8/P/hISEMv9NTU0H/6ampj3/B/8/
+ Pz8S/wAAAEX/C//Hx8f/WFhYKv9NTU0H/6ampj3/B/8/Pz8S/wAAAAf/39/fRf8L/+jo6P95
+ eXkm/01NTQf/pqamPf8H/z8/PxL/AAAAB/+vr69N/wv/sbGx/1hYWB7/TU1NB/+mpqY9/wf/
+ Pz8/Ev8AAAAH/29vb1H/C//o6Oj/bm5uGv9NTU0H/6ampj3/B/8/Pz8S/wAAAAf/Hx8fWf8H
+ /6amphb/TU1NB/+mpqY9/wf/Pz8/Fv8AAAAH/8/Pz1n/C//d3d3/bm5uDv9NTU0H/6ampj3/
+ B/8/Pz8W/wAAAAf/X19fXf8L//Pz8/+ampoK/01NTQf/pqamPf8H/z8/Pxr/AAAAB//f399h
+ /w//0tLS/2NjY/+mpqY9/wf/Pz8/Gv8AAAAH/19fX2X/C//z8/P/0tLSPf8H/z8/Px7/AAAA
+ B//Pz8+l/wf/Pz8/Hv8AAAAL/y8vL//v7++h/wf/Pz8/Iv8AAAAH/19fX6H/B/8/Pz8m/wAA
+ AAf/n5+fnf8H/z8/Pyr/AAAAB/+fn5+Z/wf/Pz8/Lv8AAAAH/5+fn5X/B/8/Pz8y/wAAAAv/
+ X19f/+/v743/B/8/Pz82/wAAAAv/Ly8v/7+/v4n/B/8/Pz8+/wAAAAv/X19f/9/f34H/B/8/
+ Pz9G/wAAAAv/X19f/6+vr3n/B/8/Pz9O/wAAABP/Dw8P/19fX/+fn5//v7+/af8H/z8/P+GW
+ /wAAAA==' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>privateIcon (in category 'icons') -----
+ privateIcon
+ 
+ 	^ Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '6cTiov8AAAET/w8PD/9fX1//j4+P/7+/vx3/E/+/v7//j4+P/19fX/8PDw+G/wAAAQv/T09P
+ /6+vrz3/C/+vr6//T09Pdv8AAAEL/09PT//f399N/wv/39/f/09PT2b/AAABC/8fHx//v7+/
+ Xf8L/7+/v/8fHx9a/wAAAQv/X19f/+/v72X/C//v7+//X19fUv8AAAEH/39/f3X/B/9/f39K
+ /wAAAQf/n5+fff8H/5+fn0L/AAABB/9/f39R/wf//v7+Mf8H/39/fzr/AAABB/9fX1+N/wf/
+ X19fMv8AAAEL/x8fH//v7+91/wf//f39Ff8L/+/v7/8fHx8u/wAAAQf/v7+/lf8H/7+/vyr/
+ AAABB/9PT0+d/wf/T09PJv8AAAEH/9/f353/B//f398i/wAAAQf/T09Ppf8H/09PTx7/AAAB
+ B/+vr6+l/wf/r6+vGv8AAAEH/w8PD63/B/8PDw8W/wAAAQf/X19frf8H/19fXxb/AAABB/+f
+ n59J/x///f39/+vr6//Y2Nj/0tLS/9vb2//v7+///v7+Sf8H/4+Pjxb/AAABB/+/v79J/yP/
+ 1dXV/4aGhv9LS0v/Nzc3/0lJSf+IiIj/2tra//7+/kX/B/+/v78W/wAAAUX/L//7+/v/09PT
+ /3p6ev8mJib/BgYG/wICAv8FBQX/IiIi/3d3d//b29v//v7+Rf8W/wAAAUX/E//r6+v/hYWF
+ /ycnJ/8DAwMO/wAAARP/AQEB/yMjI/+Dg4P/7e3tRf8W/wAAAUX/D//a2tr/TU1N/wYGBhb/
+ AAABD/8CAgL/PDw8/8rKykX/Ev8AAAEH/x8fH0X/D//T09P/NDQ0/wEBARr/AAABC/8eHh7/
+ tra2Rf8W/wAAAUX/C//V1dX/PT09Hv8AAAEL/yoqKv++vr5F/xb/AAABRf8P/+fn5/9xcXH/
+ FhYWFv8AAAEP/xQUFP9paWn/29vbRf8W/wAAAUX/E//7+/v/w8PD/2FhYf8ZGRkO/wAAARP/
+ FBQU/15eXv/AwMD/+fn5Rf8W/wAAAQf/v7+/Rf8n//n5+f/CwsL/aWlp/y0tLf8ZGRn/Kioq
+ /2lpaf/BwcH/9/f3Rf8H/7+/vxb/AAABB/+Pj49J/x///Pz8/97e3v+9vb3/srKy/7y8vP/a
+ 2tr/+fn5Sf8H/4+Pjxb/AAABB/9fX1+t/wf/X19fFv8AAAEH/w8PD63/B/8PDw8a/wAAAQf/
+ r6+vpf8H/6+vrx7/AAABB/9PT0+l/wf/T09PIv8AAAEH/9/f353/B//f398m/wAAAQf/T09P
+ nf8H/09PTyr/AAABB/+/v7+V/wf/v7+/Lv8AAAEL/x8fH//v7+91/wf/9PT0Ff8L/+/v7/8f
+ Hx8y/wAAAQf/X19fdf8H//39/RX/B/9fX186/wAAAQf/f39/hf8H/39/f0L/AAABB/+fn599
+ /wf/n5+fSv8AAAEH/39/f3X/B/9/f39S/wAAAQv/X19f/+/v7y3/Dv/7+/st/wv/7+/v/19f
+ X1r/AAABC/8fHx//v7+/Xf8L/7+/v/8fHx9m/wAAAQv/T09P/9/f303/C//f39//T09Pdv8A
+ AAEL/09PT/+vr689/wv/r6+v/09PT4b/AAABH/8PDw//X19f/4+Pj/+/v7////////n5+f/9
+ /f0R/xP/v7+//4+Pj/9fX1//Dw8P4db/AAAB' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>saveIcon (in category 'icons') -----
+ saveIcon
+ 
+ 	^ Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '6cQS/wAAAAf/AQEBuv8AAAAT/wcHB/90dHT/oqKi/zIyMh7/AAAAB/8BAQGa/wAAAAf/UVFR
+ Cf8L//f39/88PDwS/wAAAA//HBwc/3BwcP8fHx+a/wAAAAf/X19fDf8L//Dw8P8xMTEO/wAA
+ AA//0NDQ//////+5ubma/wAAAA//BAQE/7e3t//+/v4J/wv/6urq/ycnJwr/AAAAD//k5OT/
+ //////Hx8Z7/AAAAC/8KCgr/w8PDDf8T/+Li4v8eHh7/AAAA/8/Pzwn/B/8HBwee/wAAACP/
+ Dw8P/87Ozv///////v7+///////Z2dn/FhYW/7m5uQn/B/8cHBya/wAAABP/AQEB/wAAAP8V
+ FRX/2NjYDf8X/87Ozv+pqan//v7+//////8yMjKm/wAAAAv/HBwc/+Hh4Q3/B//k5OQJ/wv/
+ SEhI/wEBAab/AAAAC/8lJSX/6OjoFf8H/15eXpr/AAAAH/8mJib/ubm5/9LS0v+9vb3/qKio
+ /6ampv/29vYR/wf/c3Nzmv8AAAAH/4SEhCn/B/+JiYkS/wAAAAf/AQEBhv8AAAAL/ysrK//p
+ 6ekl/wf/eHh4Rv8AAAAH/wEBAVr/AAAAK/8KCgr/ICAg/zY2Nv9MTEz/YmJi/3d3d/+NjY3/
+ o6Oj/4WFhf8TExMK/wAAAAf/AQEBJv8AAAAH/wEBAeFG/wAAAA//ICAg/25ubv+UlJQW/6io
+ qBf/qamp/6Wlpf+EhIT/U1NT/wkJCZL/AAAAC/9AQED/qampCv+tra0H/66uriL/ra2tC/+Q
+ kJD/EBAQNv8AAAAH/wEBAVL/AAAAC/8YGBj/qampNv+tra0H/3l5eTL/AAAAB/8BAQFW/wAA
+ AAf/bm5uDv+tra0T/76+vv/S0tL/09PT/9TU1A7/09PTC//Nzc3/s7OzCv+tra0L/66urv8b
+ Gxsq/wAAAAf/AQEBWv8AAAAH/5mZmQr/ra2tB/+/v78h/wf/7OzsDv+tra0P/6qqqv+oqKj/
+ qampFv+oqKgO/6mpqRf/qKio/6Ojo/+CgoL/SUlJ/wEBAQ7/AAAAB/8BAQE2/wAAAAf/BwcH
+ Dv+tra0H/9jY2CH/B//+/v5K/62trQv/goKC/wkJCUL/AAAAB/8LCwsO/62trQf/3NzcJf8P
+ /8vLy/+tra3/rKysQv+tra0H/3Nzc0L/AAAAB/8LCwsO/62trQf/29vbJf8L//r6+v/b29sO
+ /9PT0wv/0tLS/9TU1CL/09PTG//MzMz/r6+v/62trf+urq7/ra2t/yMjIyL/AAAAB/8BAQEa
+ /wAAAAf/CwsLDv+tra0H/9vb2zH/B//+/v4p/w///v7+///////q6uoO/62trQf/U1NTPv8A
+ AAAH/wsLCw7/ra2tB//c3Nxp/wf/tLS0Cv+tra0H/2ZmZhL/AAAAB/8BAQEq/wAAAAf/CgoK
+ Dv+tra0H/9vb21H/B//+/v4V/wf/tbW1Cv+tra0H/2ZmZj7/AAAAB/8LCwsO/62trQf/29vb
+ Df8X//j4+P/W1tb/xcXF/7+/v/++vr4K/7+/vw//vr6+/7+/v//AwMAW/7+/vwf/vr6+Hv+/
+ v78H/7CwsAr/ra2tG/+ZmZn/iIiI/4eHh/90dHT/SUlJ/wUFBSr/AAAAB/8LCwsO/62trQf/
+ 29vbCf8L/+Xl5f+ysrIK/62trQf/rq6uCv+tra0H/6ysrC7/ra2tB/+urq4O/62trQf/rq6u
+ Iv+tra0L/5KSkv8SEhIm/wAAAAf/CwsLDv+tra0T/9vb2///////8vLy/7CwsHr/ra2tF/+s
+ rKz/ra2t/3t7e/8AAAD/AQEBHv8AAAAH/wsLCw7/ra2tH//a2tr//v7+/76+vv+tra3/rq6u
+ /62trf+3t7dW/8TExAf/w8PDDv/ExMQL/8PDw/+zs7MO/62trQf/EhISIv8AAAAH/wsLCw7/
+ ra2tC//b29v/3NzcDv+tra0L/8LCwv/+/v5p/wf/4+PjDv+tra0H/yEhIR7/AAAAD/8BAQH/
+ CwsL/6ysrAr/ra2tC//b29v/vb29Cv+tra0L/7Gxsf/19fVt/wf/1NTUDv+tra0H/xoaGiL/
+ AAAAB/8LCwsO/62trQf/19fXCv+tra0L/6ysrP/R0dFt/wv//Pz8/7Ozswr/ra2tC/+UlJT/
+ AQEBIv8AAAAH/wsLCw7/ra2tB//JyckO/62trQf/6urqbf8H/93d3Q7/ra2tB/9HR0cm/wAA
+ AAf/CwsLDv+tra0H/7u7uwr/ra2tC/+xsbH//f39Wf8H//7+/g3/C//+/v7/ubm5Cv+tra0L
+ /6CgoP8HBwcm/wAAAAf/CwsLDv+tra0H/6+vrwr/ra2tB//JyckZ/wf//v7+Uf8H/+bm5g7/
+ ra2tB/9aWloq/wAAAAf/CwsLGv+tra0H/+Hh4W3/B//AwMAK/62trRP/qKio/xAQEP8AAAD/
+ AQEBIv8AAAAH/wsLCxb/ra2tC/+urq7/+vr6af8H/+7u7g7/ra2tB/9qamou/wAAAAf/CwsL
+ Ev+tra0L/66urv/AwMAN/wf//v7+Xf8X/8nJyf+urq7/ra2t/66urv8eHh4u/wAAAAf/CwsL
+ Fv+tra0H/9jY2Gn/C//19fX/rq6uCv+tra0H/319fTL/AAAAB/8LCwsK/62trQf/rKysCv+t
+ ra0H//Hx8Wn/B//R0dEO/62trQf/Ly8vMv8AAAAH/wsLCxL/ra2tB/+3t7dp/wv/+vr6/7Gx
+ sQr/ra2tB/+Ojo42/wAAAAv/CwsL/66urg7/ra2tB//Pz89p/wf/2traCv+tra0L/66urv9A
+ QEAa/wAAAAf/AQEBGv8AAAAH/wsLCxL/ra2tB//o6Ohp/wf/tra2Cv+tra0L/5ycnP8EBAQ2
+ /wAAAAf/CwsLEv+tra0H/8fHx2b/ycnJB//ExMQO/62trQf/U1NTOv8AAAAH/wsLC3r/ra2t
+ B/+urq4K/62trQv/pqam/wwMDDr/AAAAC/8BAQH/qqqqdv+tra0H/6ysrAr/ra2tB/9kZGQ+
+ /wAAABP/AQEB/0tLS/+goKD/n5+fcv+Tk5MP/5GRkf9dXV3/CwsL4br/AAAA' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>shareIcon (in category 'icons') -----
+ shareIcon
+ 
+ 	^ Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '6cTiov8AAAAT/w8PD/9fX1//j4+P/7+/vx3/E/+/v7//j4+P/19fX/8PDw+G/wAAAAv/T09P
+ /6+vrz3/C/+vr6//T09Pdv8AAAAL/09PT//f399N/wv/39/f/09PT2b/AAAAC/8fHx//v7+/
+ Xf8L/7+/v/8fHx9a/wAAAAv/X19f/+/v7y3/Dv/7+/st/wv/7+/v/19fX1L/AAAAB/9/f38x
+ /xf/mZmZ/zU1Nf8gICD/NTU1/5mZmTH/B/9/f39K/wAAAAf/n5+fMf8L/5mZmf8nJycO/wAA
+ AAv/Jycn/5mZmTH/B/+fn59C/wAAAAf/f39/Mf8L//v7+/81NTUW/wAAAAv/NTU1//v7+zH/
+ B/9/f386/wAAAAf/X19fHf8K//v7+xH/C//7+/v/IyMjFv8AAAAL/yMjI//7+/sV/wf//f39
+ Hf8H/19fXzL/AAAAC/8fHx//7+/vFf8b/6mpqf9FRUX/IyMj/ywsLP91dXX/8fHxDf8H/0dH
+ Rxb/AAAAB/9HR0cR/xf/5OTk/4CAgP85OTn/ZWVl/9LS0hX/C//v7+//Hx8fLv8AAAAH/7+/
+ vxX/C//S0tL/NTU1Dv8AAAAL/xUVFf91dXUN/wv/tLS0/zIyMg7/AAAAC/8yMjL/tLS0Df8f
+ /9/f3/9FRUX/CgoK/wAAAP8FBQX/NTU1/6mpqRX/B/+/v78q/wAAAAf/T09PGf8L/2VlZf8F
+ BQUS/wAAAAv/LCws//v7+w3/F/+0tLT/R0dH/ycnJ/9HR0f/tLS0Ef8L/2lpaf8FBQUS/wAA
+ AAf/RUVFGf8H/09PTyb/AAAAB//f398V/wv//f39/zU1NRb/AAAAC/8gICD/+/v7Ff8H//39
+ /RX/C//9/f3/LCwsFv8AAAAL/yMjI//7+/sV/wf/39/fIv8AAAAH/09PTx3/C/91dXX/CQkJ
+ Ev8AAAAL/zQ0NP/7+/sx/wf/RUVFFv8AAAAL/ywsLP/7+/sZ/wf/T09PHv8AAAAH/6+vrx3/
+ D//i4uL/RUVF/wUFBQr/AAAAC/8nJyf/jo6ONf8L/6mpqf8nJycO/wAAAAv/FRUV/3V1dR3/
+ B/+vr68a/wAAAAf/Dw8PJf8X/9/f3/9paWn/LCws/0VFRf+pqak9/xv/jo6O/zQ0NP8gICD/
+ LCws/3V1df/x8fEh/wf/Dw8PFv8AAAAH/19fXy3/B//9/f1J/w7/+/v7Kf8H/19fXxb/AAAA
+ B/+fn5+t/wf/j4+PFv8AAAAH/7+/vxn/Cv/7+/tt/wr//f39Gf8H/7+/vxb/AAAAGf8X/5mZ
+ mf81NTX/IyMj/0dHR/+0tLRd/xf/tLS0/0dHR/8jIyP/NTU1/5mZmRn/Fv8AAAAV/wv/mZmZ
+ /ycnJw7/AAAAC/8yMjL/tLS0Vf8L/7S0tP8yMjIO/wAAAAv/Jycn/5mZmRX/Fv8AAAAR/wv/
+ +/v7/zU1NRb/AAAAB/9HR0dV/wf/R0dHFv8AAAAL/zU1Nf/7+/sR/xL/AAAAB/8fHx8R/wv/
+ +/v7/yAgIBb/AAAAC/8nJyf//f39Tf8L//39/f8nJycW/wAAAAv/ICAg//v7+xH/Fv8AAAAR
+ /wv/+/v7/zU1NRb/AAAAB/9HR0dV/wf/R0dHFv8AAAAL/zU1Nf/7+/sR/xb/AAAAFf8L/5mZ
+ mf8nJycO/wAAAAv/MjIy/7S0tFX/C/+0tLT/MjIyDv8AAAAL/ycnJ/+ZmZkV/xb/AAAAGf8X
+ /5mZmf81NTX/IyMj/0dHR/+0tLRd/xf/tLS0/0dHR/8jIyP/NTU1/5mZmRn/Fv8AAAAH/7+/
+ vxn/Cv/9/f1t/wr/+/v7Gf8H/7+/vxb/AAAAB/+Pj4+t/wf/j4+PFv8AAAAH/19fXyn/Dv/7
+ +/tJ/wf//f39Lf8H/19fXxb/AAAAB/8PDw8h/xv/8fHx/3V1df8sLCz/ICAg/zQ0NP+Ojo49
+ /xf/qamp/0VFRf8sLCz/aWlp/9/f3yX/B/8PDw8a/wAAAAf/r6+vHf8L/3V1df8VFRUO/wAA
+ AAv/Jycn/6mpqTX/C/+Ojo7/JycnCv8AAAAP/wUFBf9FRUX/5OTkHf8H/6+vrx7/AAAAB/9P
+ T08Z/wv/+/v7/ywsLBb/AAAAB/9FRUUx/wv/+/v7/zQ0NBL/AAAAC/8KCgr/gICAHf8H/09P
+ TyL/AAAAB//f398V/wv/+/v7/yAgIBb/AAAAC/8sLCz//f39Ff8H//39/RX/C//7+/v/ICAg
+ Fv8AAAAL/zk5Of/9/f0V/wf/39/fJv8AAAAH/09PTxX/C//7+/v/OTk5Ev8AAAAL/wUFBf9p
+ aWkR/xf/tLS0/0dHR/8nJyf/R0dH/7S0tA3/C//7+/v/LCwsEv8AAAAL/wUFBf9lZWUZ/wf/
+ T09PKv8AAAAH/7+/vxX/H/+mpqb/NTU1/wUFBf8AAAD/CgoK/0VFRf/f398N/wv/qamp/zAw
+ MA7/AAAAC/8yMjL/tLS0Df8L/3V1df8VFRUO/wAAAAv/NTU1/9LS0hX/B/+/v78u/wAAAAv/
+ Hx8f/+/v7xX/F//S0tL/ZWVl/zk5Of+AgID/5OTkEf8H/0VFRRb/AAAAB/9HR0cN/xv/8fHx
+ /3V1df8sLCz/IyMj/0VFRf+pqakV/wv/7+/v/x8fHzL/AAAAB/9fX18d/wf//f39Ff8L//v7
+ +/8jIyMW/wAAAAv/IyMj//39/RH/Cv/7+/sF/wf//f39Ff8H/19fXzr/AAAAB/9/f38x/wv/
+ +/v7/zU1NRb/AAAAC/81NTX//f39Mf8H/39/f0L/AAAAB/+fn58x/wv/mZmZ/ycnJw7/AAAA
+ C/8nJyf/mZmZMf8H/5+fn0r/AAAAB/9/f38x/xf/mZmZ/zU1Nf8gICD/NTU1/5mZmTH/B/9/
+ f39S/wAAAAv/X19f/+/v7y3/Dv/7+/st/wv/7+/v/19fX1r/AAAAC/8fHx//v7+/Xf8L/7+/
+ v/8fHx9m/wAAAAv/T09P/9/f303/C//f39//T09Pdv8AAAAL/09PT/+vr689/wv/r6+v/09P
+ T4b/AAAAH/8PDw//X19f/4+Pj/+/v7////////n5+f/9/f0R/xP/v7+//4+Pj/9fX1//Dw8P
+ 4db/AAAA' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>showNavBarIcon (in category 'icons') -----
+ showNavBarIcon
+ 	"Answer a form with the showNavBar picture"
+ 
+ 	^ Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: 
+ 
+ '6cThmQC1/xUAtf8VALX/FQC1/xUAtf8VALX/FQC1/xUAtf8VAI3/DQAd/xUAYf8NAB3/EQAd
+ /xUAYf8NABn/FQAd/xUAYf8NABX/FQAh/xUAYf8NABH/FQAl/xUAYf8NAA3/FQAp/xUAYf8N
+ AAn/FQAt/xUAYf8NAAX/FQAx/xUAYf8hADX/FQBh/x0AOf8VAGH/GQA9/xUAYf81ACH/FQBh
+ /zUAIf8VAGH/NQAh/xUAtf8VALX/FQC1/xUAIf81AGH/FQAh/zUAYf8VACH/NQBh/xUAPf8Z
+ AGH/FQA5/x0AYf8VADX/IQBh/xUAMf8VAAX/DQBh/xUALf8VAAn/DQBh/xUAKf8VAA3/DQBh
+ /xUAJf8VABH/DQBh/xUAIf8VABX/DQBh/xUAIf8RABn/DQBh/xUAIf8FAAsE////AAAAAB3/
+ DQBh/xUAtf8VALX/FQC1/xUAtf8VALX/FQC1/xUAtf8VALX/4Z0A'
+ 
+ readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>stopIcon (in category 'icons') -----
+ stopIcon
+ 
+ 	^ Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '6cThzv8AAAAH/2BgYEr/v7+/B/+QkJB2/wAAAAf/YGBgUf8H/5+fn27/AAAAB/9gYGBZ/wf/
+ n5+fZv8AAAAH/2BgYGH/B/+fn59e/wAAAAf/YGBgaf8H/5+fn1b/AAAAB/9gYGBx/wf/n5+f
+ Tv8AAAAH/2BgYHn/B/+fn59G/wAAAAf/YGBggf8H/5+fnz7/AAAAB/9gYGCJ/wf/n5+fNv8A
+ AAAH/2BgYJH/B/+fn58u/wAAAAf/YGBgmf8H/5+fnyb/AAAAB/9gYGCh/wf/n5+fHv8AAAAH
+ /2BgYKn/B/+fn58W/wAAAAf/Ly8vsf8H/5CQkBL/AAAAB/9AQECx/wf/v7+/Ev8AAAAH/0BA
+ QD3/Pv+AgIAH/9/f3zX/B/+/v78S/wAAAAf/QEBAPf8+/wAAAAf/v7+/Nf8H/7+/vxL/AAAA
+ B/9AQEA9/z7/AAAAB/+/v781/wf/v7+/Ev8AAAAH/0BAQD3/Pv8AAAAH/7+/vzX/B/+/v78S
+ /wAAAAf/QEBAPf8+/wAAAAf/v7+/Nf8H/7+/vxL/AAAAB/9AQEA9/z7/AAAAB/+/v781/wf/
+ v7+/Ev8AAAAH/0BAQD3/Pv8AAAAH/7+/vzX/B/+/v78S/wAAAAf/QEBAPf8+/wAAAAf/v7+/
+ Nf8H/7+/vxL/AAAAB/9AQEA9/z7/AAAAB/+/v781/wf/v7+/Ev8AAAAH/0BAQD3/Pv8AAAAH
+ /7+/vzX/B/+/v78S/wAAAAf/QEBAPf8+/wAAAAf/v7+/Nf8H/7+/vxL/AAAAB/9AQEA9/z7/
+ AAAAB/+/v781/wf/v7+/Ev8AAAAH/0BAQD3/Pv8AAAAH/7+/vzX/B/+/v78S/wAAAAf/QEBA
+ Pf8+/wAAAAf/v7+/Nf8H/7+/vxL/AAAAB/9AQEA9/z7/AAAAB/+/v781/wf/v7+/Ev8AAAAH
+ /0BAQD3/Pv9AQEAH/9DQ0DX/B/+/v78S/wAAAAf/QEBAsf8H/7+/vxL/AAAAB/8vLy+x/wf/
+ kJCQFv8AAAAH/2BgYKn/B/+fn58e/wAAAAf/YGBgof8H/5+fnyb/AAAAB/9gYGCZ/wf/n5+f
+ Lv8AAAAH/2BgYJH/B/+fn582/wAAAAf/YGBgif8H/5+fnz7/AAAAB/9gYGCB/wf/n5+fRv8A
+ AAAH/2BgYHn/B/+fn59O/wAAAAf/YGBgcf8H/5+fn1b/AAAAB/9gYGBp/wf/n5+fXv8AAAAH
+ /2BgYGH/B/+fn59m/wAAAAf/YGBgWf8H/5+fn27/AAAAB/9gYGBR/wf/n5+fdv8AAAAH/09P
+ T0r/gICAB/9vb2/hzv8AAAA=' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>suppliesIcon (in category 'icons') -----
+ suppliesIcon
+ 
+ 	^ Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '6cTS/wAAAAv/b29v/5+fnwr/f39/B/9fX18K/z8/Pwf/Hx8fpv8AAAAH/29vbyn/B/+vr6+a
+ /wAAAAf/f39/Lf8H/z8/Pz7/AAAAD/80NDT/aWlp/zQ0NE7/AAAAB/9/f38t/wf/Ly8vOv8A
+ AAAH/yMjIw7/jIyMC/9paWn/GhoaRv8AAAAH/09PTxn/B/9vb28O/39/fwf/T09PPv8AAAAH
+ /2lpaRb/jIyMC/9OTk7/CAgIPv8AAAAH/z8/Pxn/C//v7+//Ly8vFv8AAAAP/z8/P/9vb2//
+ Dw8PJv8AAAAH/yMjIx7/jIyMC/+Dg4P/NDQ0Ov8AAAAH/z8/Px3/C//v7+//Ly8vDv8AAAAH
+ /z8/Pwn/B//Pz88m/wAAAAf/aWlpDv+MjIwH/5qamhb/jIyMC/9paWn/GhoaMv8AAAAH/w8P
+ Dw3/C/+Pj4//z8/PDf8L/+/v7/8vLy8K/wAAAAf/f39/Df8i/wAAAAf/IyMjDv+MjIwT/6io
+ qP//////zMzM/5OTkxb/jIyMC/9OTk7/CAgILv8AAAAN/w//f39//w8PD//Pz88N/xP/7+/v
+ /09PT/8AAAD/b29vDf8H/y8vLx7/AAAAB/9paWkO/4yMjAf/4uLiCf8L//f39/+3t7cW/4yM
+ jAv/g4OD/zQ0NCr/AAAADf8T/4+Pj/8AAAD/Dw8P/8/PzxH/C/9fX1//Pz8/Df8H/z8/Pxr/
+ AAAAB/8jIyMO/4yMjAf/qKioFf8L/+Li4v+hoaEW/4yMjAv/aWlp/xoaGiL/AAAAB//Pz88J
+ /wf/v7+/Cv8AAAAL/w8PD//Pz88R/wf/n5+fDf8H/z8/Pxr/AAAAB/9paWkO/4yMjAf/4uLi
+ Hf8L/8zMzP+Tk5MW/4yMjAv/Tk5O/wgICBr/AAAAB/+Pj48J/wf/T09PDv8AAAAL/w8PD//P
+ z88d/wf/b29vFv8AAAAH/yMjIw7/jIyMB/+oqKgl/wv/9/f3/7e3txb/jIyMC/+Dg4P/NDQ0
+ Gv8AAAAL/y8vL/8fHx8W/wAAAAv/Dw8P/8/Pzxn/B/9/f38W/wAAAAf/aWlpDv+MjIwH/+Li
+ 4i3/C//i4uL/oaGhFv+MjIwL/2lpaf8ICAgi/wAAAAf/X19fCv+/v78L/5+fn/+Pj48Z/wf/
+ f39/Ev8AAAAH/yMjIw7/jIyMB/+oqKg5/wv/zMzM/5OTkxL/jIyMB/80NDQe/wAAAAf/Dw8P
+ Lf8H/6+vrxL/AAAAB/9paWkO/4yMjAf/4uLiPf8L//f39/+Tk5MO/4yMjAf/GhoaHv8AAAAH
+ /w8PDy3/B/+/v78O/wAAAAf/KysrDv+MjIwH/6ioqEH/B//i4uIO/4yMjAf/aWlpJv8AAAAH
+ /09PTwr/v7+/If8T/4+Pj/8AAAD/IyMj/2lpaRL/jIyMC/+3t7f/9/f3Pf8H/6ioqA7/jIyM
+ B/8jIyM+/wAAAA7/Pz8/E/9/f3//X19f/yMjI/9paWke/4yMjAv/mpqa/9vb2zX/B//i4uIO
+ /4yMjAf/aWlpTv8AAAAL/yMjI/9paWku/4yMjAv/qKio//Dw8C3/B/+oqKgO/4yMjAf/IyMj
+ Rv8AAAAL/yMjI/9paWka/4yMjBP/qKio/+Li4v/FxcX/k5OTFv+MjIwL/8XFxf/39/ch/wf/
+ 4uLiDv+MjIwH/2lpaUL/AAAAC/8jIyP/aWlpGv+MjIwL/6ioqP/i4uIN/wv/8PDw/6+vrxb/
+ jIyMC/+ampr/29vbHf8H/6ioqA7/jIyMB/8jIyM6/wAAAAv/IyMj/2lpaRr/jIyMC/+oqKj/
+ 4uLiHf8L/+Li4v+ampoW/4yMjAv/qKio//Dw8BH/B//i4uIO/4yMjAf/aWlpOv8AAAAH/0ZG
+ Rhr/jIyMC/+oqKj/4uLiLf8L/8XFxf+Tk5MW/4yMjAv/xcXF//f39wn/B/+oqKgO/4yMjAf/
+ IyMjOv8AAAAH/2lpaRL/jIyMC/+Tk5P/4uLiOf8L//Dw8P+vr68W/4yMjA//mpqa/9vb2//i
+ 4uIO/4yMjAf/aWlpPv8AAAAH/2lpaRb/jIyMC/+ampr/4uLiPf8L/+Li4v+ampoW/4yMjAf/
+ k5OTDv+MjIwH/yMjIz7/AAAAB/9paWke/4yMjAv/r6+v//Dw8D3/C//FxcX/k5OTGv+MjIwH
+ /2lpaUL/AAAAB/9paWkK/4yMjAf/k5OTFv+MjIwL/5OTk//FxcU9/wv/8PDw/5qamhb/jIyM
+ B/8jIyNC/wAAAAf/aWlpCv+MjIwP/6ioqP/w8PD/qKioFv+MjIwL/5qamv/i4uIx/wv/09PT
+ /5qamhr/jIyMRv8AAAAH/2lpaQr/jIyMB/+oqKgJ/wv/29vb/5qamhb/jIyMC/+vr6//8PDw
+ If8L/9PT0/+ampoi/4yMjEb/AAAAB/9paWkK/4yMjAf/qKioDf8L//f39//FxcUW/4yMjAv/
+ k5OT/8XFxRX/C//T09P/mpqaGv+MjIwH/5qamg7/jIyMRv8AAAAH/2lpaQr/jIyMB/+oqKgV
+ /wv/8PDw/6ioqBb/jIyMF/+ampr/4uLi///////T09P/mpqaGv+MjIwP/7e3t//w8PD/xcXF
+ Dv+MjIxG/wAAAAf/aWlpCv+MjIwH/6ioqB3/C//b29v/mpqaFv+MjIwH/5OTkxr/jIyMC/+3
+ t7f/8PDwCf8H/8XFxQ7/jIyMRv8AAAAH/2lpaQr/jIyMB/+oqKgh/wv/9/f3/8XFxSb/jIyM
+ C/+3t7f/8PDwEf8H/8XFxQ7/jIyMRv8AAAAH/2lpaQr/jIyMB/+oqKgp/wv/8PDw/6ioqBb/
+ jIyMC/+3t7f/8PDwGf8H/8XFxQ7/jIyMRv8AAAAH/2lpaQr/jIyMB/+oqKgx/wf/vr6+Dv+M
+ jIwH//Dw8CH/B//FxcUO/4yMjEb/AAAAB/9paWkK/4yMjAv/mpqa//Dw8C3/B//FxcUO/4yM
+ jCX/B//FxcUO/4yMjEb/AAAAB/9paWkS/4yMjAv/xcXF//f39yX/B//FxcUO/4yMjCX/B//F
+ xcUO/4yMjEb/AAAAB/9GRkYW/4yMjAv/mpqa/9vb2yH/B//FxcUO/4yMjCX/B//FxcUO/4yM
+ jEr/AAAAC/8jIyP/enp6Fv+MjIwL/6ioqP/w8PAZ/wf/xcXFDv+MjIwh/wv/9/f3/6+vrw7/
+ jIyMUv8AAAAL/0ZGRv+Dg4MW/4yMjAv/xcXF//f39xH/B//FxcUO/4yMjBn/D//39/f/xcXF
+ /5OTkxL/jIyMVv8AAAAL/xEREf9gYGAW/4yMjAv/mpqa/9vb2w3/B//FxcUO/4yMjBH/D//3
+ 9/f/xcXF/5OTkxb/jIyMB/9paWle/wAAAAv/IyMj/3p6ehb/jIyME/+oqKj/8PDw///////F
+ xcUO/4yMjAn/D//39/f/xcXF/5OTkxb/jIyMD/+Dg4P/RkZG/wgICGb/AAAAC/9GRkb/g4OD
+ Fv+MjIwL/8XFxf++vr4O/4yMjA//9/f3/8XFxf+Tk5MW/4yMjA//g4OD/0ZGRv8ICAhy/wAA
+ AAv/ERER/2BgYCb/jIyMB/+Tk5MW/4yMjA//g4OD/0ZGRv8ICAiC/wAAAAv/IyMj/3p6ei7/
+ jIyMD/+Dg4P/RkZG/wgICJL/AAAAC/9GRkb/g4ODHv+MjIwP/4ODg/9GRkb/CAgInv8AAAAL
+ /xEREf9gYGAS/4yMjA//g4OD/0ZGRv8ICAiu/wAAABf/IyMj/3p6ev+Dg4P/RkZG/wgICOEa
+ /wAAAA==' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>undoIcon (in category 'icons') -----
+ undoIcon
+ 
+ 	^ Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '6cTnTv8AAAAH/1JSUgr/zs7OB/9ERES2/wAAABf/a2tr/97e3v/f39//3t7e/6Kioq7/AAAA
+ C/8VFRX/lJSUEv/e3t4H/4eHh6r/AAAAC/8hISH/sbGxEv/e3t4L/4aGhv8WFham/wAAAA//
+ LCws/8/Pz//f398K/97e3gv/4ODg/2tra6r/AAAAB/9RUVEK/97e3hP/39/f/97e3v/Ozs7/
+ UlJSqv8AAAAL/3h4eP/f398K/97e3g//39/f/8/Pz/8sLCym/wAAAAv/FRUV/5OTkxL/3t7e
+ D//Pz8//RUVF/zg4OBL/OTk5D/84ODj/OTk5/zg4OAr/OTk5Ev84ODgP/zk5Of84ODj/Hx8f
+ Zv8AAAAT/6Kiov/f39//3t7e/+Dg4Bb/3t7eD//f39//3t7e/9/f3xb/3t7eB//g4OAK/97e
+ 3gf/39/fEv/e3t4P/8DAwP94eHj/ICAgWv8AAAAy/97e3hL/39/fB//e3t4K/9/f3xL/3t7e
+ H//f39//3t7e/9/f3//e3t7/39/f/3h4eP8UFBRS/wAAAAf/hoaGCv/e3t4H/9/f3w7/3t7e
+ Dv/f398S/97e3gf/39/fHv/e3t4H/9/f3wr/3t7eB//f398O/97e3gv/sbGx/yAgIFL/AAAA
+ B/94eHgW/97e3gf/X19fCv85OTkH/zg4OA7/OTk5Dv84ODga/zk5ORf/ODg4/2tra//AwMD/
+ 3t7e/9/f3wr/3t7eC//Ozs7/ISEhUv8AAAAP/1FRUf/Ozs7/39/fCv/e3t4L/8/Pz/9SUlJG
+ /wAAAA//X19f/87Ozv/f398K/97e3gf/sbGxVv8AAAAL/ywsLP/Ozs4S/97e3gf/bGxsRv8A
+ AAAL/ywsLP/Pz88K/97e3gv/39/f/2xsbFb/AAAAE/8VFRX/sLCw/97e3v/f398K/97e3gv/
+ hYWF/xUVFUL/AAAAC/8sLCz/3t7eCv/f398L/8/Pz/8WFhZW/wAAAAv/FRUV/4aGhhL/3t7e
+ C/+xsbH/FBQUQv8AAAAH/2xsbAr/3t7eC//f39//UlJSXv8AAAAP/2xsbP/e3t7/39/fCv/e
+ 3t4H/5WVlUL/AAAAF/8VFRX/39/f/+Dg4P/e3t7/lJSUYv8AAAAX/1JSUv/Pz8//3t7e/9/f
+ 3/+VlZVG/wAAAAf/oqKiCv/e3t4H/87Ozmb/AAAAE/8sLCz/lJSU/6Kiov8sLCxG/wAAAAf/
+ a2trCv/f398H/97e3rr/AAAAB/9sbGwO/97e3rr/AAAAB/94eHgO/97e3rr/AAAAE/+xsbH/
+ 39/f/97e3v+wsLC2/wAAAAf/LCwsDv/e3t4H/4eHh7b/AAAAB/+ioqIO/97e3gf/RUVFsv8A
+ AAAH/2BgYA7/3t7eB/+/v7+y/wAAAA//Xl5e/97e3v/f398K/97e3gf/OTk5qv8AAAAT/zg4
+ OP+hoaH/3t7e/9/f3wr/3t7eB/94eHhS/wAAAAf/FRUVDv9ra2sO/2xsbAr/ampqB/9ra2sK
+ /2xsbAr/ampqDv9sbGwH/2trawr/bGxsE/9ra2v/eHh4/7Gxsf/g4OAK/97e3g//39/f/97e
+ 3v+Hh4dW/wAAAAf/sbGxEv/e3t4H/9/f3xr/3t7eB//f398e/97e3gf/39/fDv/e3t4H/9/f
+ 3wr/3t7eB/94eHha/wAAAAv/3t7e/9/f3xb/3t7eB//f398i/97e3gf/39/fGv/e3t4T/9/f
+ 3//e3t7/oaGh/zg4OF7/AAAAC/9sbGz/39/fHv/e3t4H/9/f3x7/3t7eB//f398S/97e3g//
+ oqKi/3d3d/8rKyvoDv8AAAA=' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary class>>zoomIcon (in category 'icons') -----
+ zoomIcon
+ 
+ 	^ Form extent: 50 at 50 depth: 32 bits: (Base64MimeConverter mimeDecodeToBytes: '6cTj+v8AAAAH/xoaGqb/IyMjB/8ICAga/wAAAAf/RkZGqv+MjIwL/4ODg/8ICAgW/wAAAAf/
+ aWlprv+MjIwH/yMjIxb/AAAAB/9paWmu/4yMjAf/IyMjFv8AAAAH/2lpaQr/jIyMB/+ioqKS
+ /+Pj4wf/zc3NDv+MjIwH/yMjIxb/AAAAB/9paWkK/4yMjAf/qampkf8H/+Pj4w7/jIyMB/8j
+ IyMW/wAAAAf/aWlpCv+MjIwH/6mpqZH/B//j4+MO/4yMjAf/IyMjFv8AAAAH/2lpaQr/jIyM
+ B/+pqakN/wf/8fHxJv/GxsYH/9TU1CH/B//x8fEm/8bGxgf/1NTUDf8H/+Pj4w7/jIyMB/8j
+ IyMW/wAAAAf/aWlpCv+MjIwH/6mpqQ3/B/+ampom/4yMjAf/qampIf8H/+Pj4yr/jIyMB//U
+ 1NQJ/wf/4+PjDv+MjIwH/yMjIxb/AAAAB/9paWkK/4yMjAf/qampDf8q/4yMjAf/qampIf8H
+ /+Pj4yr/jIyMB//GxsYJ/wf/4+PjDv+MjIwH/yMjIxb/AAAAB/9paWkK/4yMjAf/qampDf8q
+ /4yMjAf/oqKiIf8H/+Pj4yr/jIyMB//GxsYJ/wf/4+PjDv+MjIwH/yMjIxb/AAAAB/9paWkK
+ /4yMjAf/qampDf8O/4yMjAf/xsbGXf8O/4yMjAf/xsbGCf8H/+Pj4w7/jIyMB/8jIyMW/wAA
+ AAf/aWlpCv+MjIwH/6mpqQ3/Dv+MjIwH/8bGxl3/Dv+MjIwH/8bGxgn/B//j4+MO/4yMjAf/
+ IyMjFv8AAAAH/2lpaQr/jIyMB/+pqakN/w7/jIyMB//GxsZd/w7/jIyMB//GxsYJ/wf/4+Pj
+ Dv+MjIwH/yMjIxb/AAAAB/9paWkK/4yMjAf/qampDf8O/4yMjAf/xsbGXf8O/4yMjAf/xsbG
+ Cf8H/+Pj4w7/jIyMB/8jIyMW/wAAAAf/aWlpCv+MjIwH/6mpqQ3/Dv+MjIwH/8bGxl3/Dv+M
+ jIwH/8bGxgn/B//j4+MO/4yMjAf/IyMjFv8AAAAH/2lpaQr/jIyMB/+pqakN/w7/jIyMB//G
+ xsZd/w7/jIyMB//GxsYJ/wf/4+PjDv+MjIwH/yMjIxb/AAAAB/9paWkK/4yMjAf/qampDf8O
+ /4yMjAf/xsbGXf8O/4yMjAf/xsbGCf8H/+Pj4w7/jIyMB/8jIyMW/wAAAAf/aWlpCv+MjIwH
+ /6mpqQ3/Dv/j4+MH//Hx8V3/Dv/j4+MH//Hx8Qn/B//j4+MO/4yMjAf/IyMjFv8AAAAH/2lp
+ aQr/jIyMB/+pqamR/wf/4+PjDv+MjIwH/yMjIxb/AAAAB/9paWkK/4yMjAf/qampkf8H/+Pj
+ 4w7/jIyMB/8jIyMW/wAAAAf/aWlpCv+MjIwH/6mpqZH/B//j4+MO/4yMjAf/IyMjFv8AAAAH
+ /2lpaQr/jIyMB/+pqakN/w7/4+PjB//x8fFd/w7/4+PjB//x8fEJ/wf/4+PjDv+MjIwH/yMj
+ Ixb/AAAAB/9paWkK/4yMjAf/qampDf8O/4yMjAf/xsbGXf8O/4yMjAf/xsbGCf8H/+Pj4w7/
+ jIyMB/8jIyMW/wAAAAf/aWlpCv+MjIwH/6mpqQ3/Dv+MjIwH/8bGxl3/Dv+MjIwH/8bGxgn/
+ B//j4+MO/4yMjAf/IyMjFv8AAAAH/2lpaQr/jIyMB/+pqakN/w7/jIyMB//GxsZd/w7/jIyM
+ B//GxsYJ/wf/4+PjDv+MjIwH/yMjIxb/AAAAB/9paWkK/4yMjAf/qampDf8O/4yMjAf/xsbG
+ Xf8O/4yMjAf/xsbGCf8H/+Pj4w7/jIyMB/8jIyMW/wAAAAf/aWlpCv+MjIwH/6mpqQ3/Dv+M
+ jIwH/8bGxl3/Dv+MjIwH/8bGxgn/B//j4+MO/4yMjAf/IyMjFv8AAAAH/2lpaQr/jIyMB/+p
+ qakN/w7/jIyMB//GxsZd/w7/jIyMB//GxsYJ/wf/4+PjDv+MjIwH/yMjIxb/AAAAB/9paWkK
+ /4yMjAf/qampDf8O/4yMjAf/xsbGXf8O/4yMjAf/xsbGCf8H/+Pj4w7/jIyMB/8jIyMW/wAA
+ AAf/aWlpCv+MjIwH/6mpqQ3/Kv+MjIwH/6mpqSH/B//j4+Mq/4yMjAf/xsbGCf8H/+Pj4w7/
+ jIyMB/8jIyMW/wAAAAf/aWlpCv+MjIwH/6mpqQ3/Kv+MjIwH/6mpqSH/B//j4+Mq/4yMjAf/
+ xsbGCf8H/+Pj4w7/jIyMB/8jIyMW/wAAAAf/aWlpCv+MjIwH/6mpqQ3/B/+ampom/4yMjAf/
+ qampIf8H/+Pj4yr/jIyMB//U1NQJ/wf/4+PjDv+MjIwH/yMjIxb/AAAAB/9paWkK/4yMjAf/
+ qampDf8H//Hx8Sb/xsbGB//Nzc0h/wf/8fHxJv/GxsYH/9TU1A3/B//j4+MO/4yMjAf/IyMj
+ Fv8AAAAH/2lpaQr/jIyMB/+pqamR/wf/4+PjDv+MjIwH/yMjIxb/AAAAB/9paWkK/4yMjAf/
+ qampkf8H/+Pj4w7/jIyMB/8jIyMW/wAAAAf/aWlpCv+MjIwH/6KiopL/4+PjB//Nzc0O/4yM
+ jAf/IyMjFv8AAAAH/2lpaa7/jIyMB/8jIyMW/wAAAAf/aWlprv+MjIwH/yMjIxb/AAAAB/9G
+ Rkaq/4yMjAv/g4OD/wgICBr/AAAAB/8aGhqm/yMjIwf/CAgI4y7/AAAA' readStream) contents!

Item was added:
+ ----- Method: SugarLibrary>>iconAt: (in category 'icon images') -----
+ iconAt: aName
+ 
+ 	^ iconDictionary at: aName.
+ !

Item was added:
+ ----- Method: SugarLibrary>>iconAt:ifAbsent: (in category 'icon images') -----
+ iconAt: aName ifAbsent: aBlock
+ 	"If the IconDictionary has entry filed under the first argument, answer that entry; if not (e.g. during development) then answer the result of evaluating the block provided"
+ 
+ 	^ iconDictionary at: aName ifAbsent: [aBlock value]!

Item was added:
+ ----- Method: SugarLibrary>>iconAt:put: (in category 'icon images') -----
+ iconAt: aName put: aForm
+ 
+ 	^ iconDictionary at: aName put: aForm.
+ !

Item was added:
+ ----- Method: SugarLibrary>>imageFor:color: (in category 'icon images') -----
+ imageFor: aString color: aColor
+ 
+ 	^ self imageFor: aString color: aColor grayOutColor: nil.
+ !

Item was added:
+ ----- Method: SugarLibrary>>imageFor:color:grayOutColor: (in category 'icon images') -----
+ imageFor: aString color: aColor grayOutColor: grayOutColor
+ 	"Answer an image corresponding to the given string, using the specified color scheme."
+ 
+ 	| icon g h orig w height ret f |
+ 	icon _ self iconAt: aString ifAbsent: [self iconAt: #missingIcon].
+ 	icon unhibernate.
+ 	grayOutColor ifNotNil: [
+ 		f _ Form extent: icon extent depth: 32.
+ 		f fillColor: grayOutColor.
+ 		icon displayOn: f at: 0 at 0 rule: 37.
+ 		icon _ f.
+ 	].
+ 
+ 	orig _ Form new hackBits: icon bits.
+ 	height _ icon width * icon height.
+ 
+ 	g _ Form extent: icon extent depth: 32.
+ 	h _ Form new hackBits: g bits.
+ 
+ 	w _ WarpBlt current toForm: h.
+ 	w sourceForm: orig.
+ 	w cellSize: 1.
+ 	w combinationRule: Form over.
+ 	w copyQuad: {1 at 0. 1 at height. 2 at height. 2 at 0} toRect: (0 at 0 corner: 4@(height + 1)).
+ 	ret _ (Form extent: icon extent depth: 32) fillColor: aColor.
+ 	g displayOn: ret at: 0 rule: 34.
+ 	^ ret asFormOfDepth: 16!

Item was added:
+ ----- Method: SugarLibrary>>initialize (in category 'icon images') -----
+ initialize
+ 
+ 	super initialize.
+ 	iconDictionary _ Dictionary new.
+ !

Item was added:
+ ----- Method: SugarLibrary>>loadFrom: (in category 'icon images') -----
+ loadFrom: aFileDirectory
+ 
+ 	aFileDirectory fileNames do: [:fName |
+ 		(fName endsWith: 'White.png') ifTrue: [
+ 			iconDictionary at: (fName copyFrom: 1 to: fName size - 9) put: ((PNGReadWriter on: (aFileDirectory readOnlyFileNamed: fName)) nextImage asFormOfDepth: 32).
+ 		]
+ 	].
+ !

Item was added:
+ ----- Method: SugarLibrary>>makeButton:balloonText:for:target:baseColor:highLightColor: (in category 'icon images') -----
+ makeButton: aString balloonText: anotherString for: aSymbol target: target baseColor: baseColor highLightColor: highLightColor
+ 	"Answer a SugarButton constructed from the arguments."
+ 
+ 	| s keyString img |
+ 	keyString _ aSymbol asString.
+ 	s _ SugarButton new.
+ 	img _ self iconAt: aString ifAbsent: [self iconAt: #missingIcon].
+ 	self recolorButton: s for: keyString baseColor: baseColor highLightColor: highLightColor.
+ 	s extent: img extent + (25 at 25).
+ 	s target: target.
+ 	s actionSelector: aSymbol.
+ 	s setBalloonText: anotherString.
+ 	^ s!

Item was added:
+ ----- Method: SugarLibrary>>recolorButton:for:baseColor:highLightColor: (in category 'icon images') -----
+ recolorButton: aSugarButton for: aSymbol baseColor: baseColor highLightColor: highLightColor
+ 
+ 	| keyString |
+ 	keyString _ aSymbol asString.
+ 	aSugarButton onImage: (self imageFor: keyString color: highLightColor).
+ 	aSugarButton offImage: (self imageFor: keyString color: baseColor).
+ 	aSugarButton disabledImage: (self imageFor: keyString color: baseColor grayOutColor: Color gray).
+ 	aSugarButton highLightColor: highLightColor.
+ 	aSugarButton color: baseColor.
+ 	^ aSugarButton.
+ !

Item was added:
+ EToyListenerMorph subclass: #SugarListenerMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sugar'!

Item was added:
+ ----- Method: SugarListenerMorph class>>ensureListenerInCurrentWorld (in category 'as yet unclassified') -----
+ ensureListenerInCurrentWorld
+ 
+ !

Item was added:
+ ----- Method: SugarListenerMorph>>addNewObject:thumbForm:sentBy:ipAddress: (in category 'as yet unclassified') -----
+ addNewObject: newObject thumbForm: aForm sentBy: senderName ipAddress: ipAddressString
+ 
+ 	newObject openInHand.
+ 	self class removeAllFromGlobalIncomingQueue.
+ 	self position: -200 at -200.!

Item was added:
+ FlapTab subclass: #SugarNavTab
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sugar'!

Item was added:
+ ----- Method: SugarNavTab class>>additionsToViewerCategories (in category 'scripting') -----
+ 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."
+ 
+ 	^ #(
+ 
+ 	(navigator (
+ (command useGreenLook 'use green look')
+ (command useGrayLook 'use gray look')
+ (slot highlightColor 'The highlight color for the navigator bar' Color readWrite Player getHighlightColor Player setHighlightColor:)
+ )))!

Item was added:
+ ----- Method: SugarNavTab>>addCustomMenuItems:hand: (in category 'menu') -----
+ addCustomMenuItems: aMenu hand: aHandMorph
+ 	"Add further items to the menu as appropriate"
+ 
+ 	aMenu addLine.
+ 	"aMenu addUpdating: #edgeString action: #setEdgeToAdhereTo."
+ 	"aMenu add: 'destroy this flap' translated action: #destroyFlap." "we do not want accidental removal"
+ 
+ 	aMenu addLine.
+ 
+ 	aMenu add: 'use default green look' translated action: #makeGreen.
+ 	aMenu add: 'use default gray look' translated action: #makeGray.
+ 	aMenu add: 'color...' translated target: self action: #changeColor.
+ 	aMenu add: 'highlight color...' translated target: self action: #changeHighlightColor.
+ 	aMenu add: 'height...' translated target: self action: #changeNaviHeight.
+ !

Item was added:
+ ----- Method: SugarNavTab>>adjustPositionAfterHidingFlap (in category 'positioning') -----
+ adjustPositionAfterHidingFlap
+ 	self showFlap.
+ 	referent checkForResize.
+ 	self goBehind.!

Item was added:
+ ----- Method: SugarNavTab>>changeColor (in category 'events') -----
+ changeColor
+ 
+ 	referent ifNil: [^ self].
+ 	ColorPickerMorph new
+ 		choseModalityFromPreference;
+ 		sourceHand: self activeHand;
+ 		target: referent;
+ 		selector: #color:;
+ 		originalColor: referent color;
+ 		putUpFor: self near: self fullBoundsInWorld!

Item was added:
+ ----- Method: SugarNavTab>>changeHighlightColor (in category 'events') -----
+ changeHighlightColor
+ 
+ 	referent ifNil: [^ self].
+ 	ColorPickerMorph new
+ 		choseModalityFromPreference;
+ 		sourceHand: self activeHand;
+ 		target: referent;
+ 		selector: #highLightColor:;
+ 		originalColor: referent color;
+ 		putUpFor: self near: self fullBoundsInWorld!

Item was added:
+ ----- Method: SugarNavTab>>changeNaviHeight (in category 'events') -----
+ changeNaviHeight
+ 
+ 	| f n |
+ 	referent ifNil: [^ self].
+ 
+ 	f _ FillInTheBlank request: 'new height of the bar' initialAnswer: referent height asString.
+ 	n _ f asNumber min: (Display height // 2) max: 0.
+ 	self naviHeight: n.!

Item was added:
+ ----- Method: SugarNavTab>>collapsedMode (in category 'positioning') -----
+ collapsedMode
+ 	"Answer whether the receiver is currently showing only as a single open-nav-bar button at top-right of the screen."
+ 
+ 	^ self hasProperty: #collapsedMode!

Item was added:
+ ----- Method: SugarNavTab>>collapsible (in category 'positioning') -----
+ collapsible
+ 	"Answer whether the receiver can be collapsed."
+ 
+ 	^ false!

Item was added:
+ ----- Method: SugarNavTab>>handleMouseMove: (in category 'events') -----
+ handleMouseMove: evt
+ !

Item was added:
+ ----- Method: SugarNavTab>>hideFlap (in category 'positioning') -----
+ hideFlap
+ !

Item was added:
+ ----- Method: SugarNavTab>>hideNavBar (in category 'initialization') -----
+ hideNavBar
+ 	"Hide the nav bar."
+ 
+ 	self setProperty: #collapsedMode toValue: true.
+ 	referent delete.
+ 	referent showOnlyShowNavBarButton.
+ 	self hResizing: #shrinkWrap.
+ 	referent layoutInset: 0 at 0.
+ 	self edgeToAdhereTo: #topRight.
+ 	self occupyTopRightCorner.
+ 	self addMorphBack: referent!

Item was added:
+ ----- Method: SugarNavTab>>highlightColor (in category 'accessing') -----
+ highlightColor
+ 	"Answer the highlight color used by buttons in the nav bar."
+ 
+ 	^ referent highLightColor!

Item was added:
+ ----- Method: SugarNavTab>>highlightColor: (in category 'accessing') -----
+ highlightColor: aColor
+ 	"Set the highlight color to be used with buttons in the sugar nav bar."
+ 
+ 	^ referent highLightColor: aColor!

Item was added:
+ ----- Method: SugarNavTab>>makeGray (in category 'initialization') -----
+ makeGray
+ 
+ 	referent ifNotNil: [referent makeGray].
+ !

Item was added:
+ ----- Method: SugarNavTab>>makeGreen (in category 'initialization') -----
+ makeGreen
+ 
+ 	referent ifNotNil: [referent makeGreen].
+ !

Item was added:
+ ----- Method: SugarNavTab>>mouseMove: (in category 'events') -----
+ mouseMove: evt
+ !

Item was added:
+ ----- Method: SugarNavTab>>mouseUp: (in category 'events') -----
+ mouseUp: evt
+ 
+ !

Item was added:
+ ----- Method: SugarNavTab>>naviHeight: (in category 'positioning') -----
+ naviHeight: anInteger
+ 
+ 	referent ifNotNil: [referent naviHeight: anInteger].
+ !

Item was added:
+ ----- Method: SugarNavTab>>nonStandardMorphs (in category 'initialization') -----
+ nonStandardMorphs
+ 
+ 	^ (submorphs copy reject: [:e | e isMemberOf: SugarNavigatorBar]) collect: [:e | Array with: e with: e position - self position]!

Item was added:
+ ----- Method: SugarNavTab>>occupyTopRightCorner (in category 'positioning') -----
+ occupyTopRightCorner
+ 	"Make the receiver be the correct size, and occupy the top-right corner of the screen."
+ 
+ 	| worldBounds toUse |
+ 	worldBounds := ActiveWorld bounds.
+ "	toUse := Preferences useArtificialSweetenerBar
+ 		ifFalse:
+ 			[75]
+ 		ifTrue:
+ 			[(ActiveWorld  extent >= (1200 @ 900))
+ 				ifTrue:
+ 					[75]
+ 				ifFalse:
+ 					[40]]."
+ 	toUse := 40.  "Trying for the moment to use the smaller icon always when in this mode."
+ 
+ 	referent height: toUse; resizeButtonsAndTabTo: toUse.
+ 	self extent: toUse @ toUse.
+ 	self topRight: worldBounds topRight!

Item was added:
+ ----- Method: SugarNavTab>>okayToBrownDragEasily (in category 'accessing') -----
+ okayToBrownDragEasily
+ 	
+ 
+ 	^ false!

Item was added:
+ ----- Method: SugarNavTab>>okayToResizeEasily (in category 'accessing') -----
+ okayToResizeEasily
+ 	"Answer whether the receiver would be glad to offer a grow handle."
+ 
+ 	^ false!

Item was added:
+ ----- Method: SugarNavTab>>okayToRotateEasily (in category 'accessing') -----
+ okayToRotateEasily
+ 	"Answer whether it is appropriate for a rotation handle to be shown for the receiver. "
+ 
+ 	^ false!

Item was added:
+ ----- Method: SugarNavTab>>positionReferent (in category 'positioning') -----
+ positionReferent
+ !

Item was added:
+ ----- Method: SugarNavTab>>setEdge: (in category 'menu') -----
+ setEdge: anEdge
+ 
+ 	super setEdge: anEdge.
+ 	referent setEdge: anEdge.!

Item was added:
+ ----- Method: SugarNavTab>>setEdgeToAdhereTo (in category 'menu') -----
+ setEdgeToAdhereTo
+ 	| aMenu |
+ 	aMenu _ MenuMorph new defaultTarget: self.
+ 	#(top bottom) do:
+ 		[:sym | aMenu add: sym asString translated target: self selector:  #setEdge: argument: sym].
+ 	aMenu popUpEvent: self currentEvent in: self world!

Item was added:
+ ----- Method: SugarNavTab>>showFlap (in category 'positioning') -----
+ showFlap
+ 	"Open the flap up"
+ 
+ 	| thicknessToUse flapOwner |
+ 
+ 	"19 sept 2000 - going for all paste ups <- raa note"
+ 	self lazyUnhibernate.
+ 	flapOwner _ self pasteUpMorph.
+ 	self referentThickness <= 0
+ 		ifTrue:
+ 			[thicknessToUse _ lastReferentThickness ifNil: [100].
+ 			self orientation == #horizontal
+ 				ifTrue:
+ 					[referent height: thicknessToUse]
+ 				ifFalse:
+ 					[referent width: thicknessToUse]].
+ 	inboard ifTrue:
+ 		[self stickOntoReferent].  "makes referent my owner, and positions me accordingly"
+ 	referent pasteUpMorph == flapOwner
+ 		ifFalse:
+ 			[flapOwner accommodateFlap: self.  "Make room if needed"
+ 			self addMorph: referent.
+ 			flapOwner startSteppingSubmorphsOf: referent.
+ 			self positionReferent.
+ 			referent adaptToWorld: flapOwner].
+ 	inboard  ifFalse:
+ 		[self adjustPositionVisAVisFlap].
+ 	flapShowing _ false.  "This is really tricky...  It is a way to always show it"
+ 	self owner addMorphBack: self.
+ !

Item was added:
+ ----- Method: SugarNavTab>>showNavBar (in category 'initialization') -----
+ showNavBar
+ 	"Show the full nav-bar across the top of the screen."
+ 
+ 	self removeProperty: #collapsedMode.
+ 	referent delete.
+ 	
+ 	referent rebuildButtons; hResizing: #spaceFill.
+ 	Preferences useArtificialSweetenerBar ifTrue: [referent configureForSqueakland].
+ 
+ 	self hResizing: #spaceFill.
+ 	self edgeToAdhereTo: #top.
+ 	self position: 0 at 0.
+ 	
+ 	self addMorph: referent!

Item was added:
+ ----- Method: SugarNavTab>>spanWorld (in category 'positioning') -----
+ spanWorld
+ 	"Make the receiver's height or width commensurate with that of the container."
+ 
+ 	| container |
+ 
+ 	self collapsedMode ifTrue:
+ 		[^ self occupyTopRightCorner].
+ 
+ 	container _ self pasteUpMorph ifNil: [self currentWorld].
+ 	(self orientation == #vertical) ifTrue: [
+ 		referent vResizing == #rigid 
+ 			ifTrue:[referent spanContainerVertically: container height].
+ 		referent hResizing == #rigid 
+ 			ifTrue:[referent width: (referent width min: container width - self width)].
+ 		referent top: container top + self referentMargin y.
+ 	] ifFalse: [
+ 		referent hResizing == #rigid
+ 			ifTrue:[referent width: container width].
+ 		referent vResizing == #rigid
+ 			ifTrue:[referent height: (referent height min: container height - self height)].
+ 		referent left: container left + self referentMargin x.
+ 	] !

Item was added:
+ ----- Method: SugarNavTab>>wantsHalo (in category 'events') -----
+ wantsHalo
+ 
+ 	^ false.
+ !

Item was added:
+ ----- Method: SugarNavTab>>wantsHaloFromClick (in category 'events') -----
+ wantsHaloFromClick
+ 
+ 	^ true.
+ !

Item was added:
+ ----- Method: SugarNavTab>>wantsHaloHandleWithSelector:inHalo: (in category 'menu') -----
+ wantsHaloHandleWithSelector: aSelector inHalo: aHaloMorph
+ 	"Answer whether the receiver would like to offer the halo handle with the given selector (e.g. #addCollapseHandle:)"
+ 
+ 	(#(addDupHandle: addMakeSiblingHandle: addCollapseHandle: ) includes: aSelector) ifTrue:
+ 		[^ false].
+ 
+ 	^ super wantsHaloHandleWithSelector: aSelector inHalo: aHaloMorph
+ !

Item was added:
+ ----- Method: SugarNavTab>>wantsToBeTopmost (in category 'positioning') -----
+ wantsToBeTopmost
+ 
+ 	^ false.
+ !

Item was added:
+ ----- Method: SugarNavTab>>wording (in category 'menu') -----
+ wording
+ 
+ 	^ 'Sugar Navigation Flap' translated.
+ !

Item was added:
+ ProjectNavigationMorph subclass: #SugarNavigatorBar
+ 	instanceVariableNames: 'sugarLib highLightColor paintButton undoButton shareButton stopButton supplies listener suppliesFlap projectNameField isSugar'
+ 	classVariableNames: 'ShowHideButton ShowSugarNavigator'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sugar'!

Item was added:
+ ----- Method: SugarNavigatorBar class>>configureCurrentForSqueakland (in category 'utilitity') -----
+ configureCurrentForSqueakland
+ 
+ 	SugarNavigatorBar current ifNotNilDo: [:bar | bar configureForSqueakland].
+ !

Item was added:
+ ----- Method: SugarNavigatorBar class>>current (in category 'instance creation') -----
+ current
+ 
+ 	| flap |
+ 	flap _ Flaps globalFlapTabWithID: 'Sugar Navigator Flap' translated.
+ 	flap ifNil: [^ nil].
+ 	(flap referent isMemberOf: SugarNavigatorBar) ifFalse: [^ nil].
+ 	^ flap referent.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar class>>findAnythingMorph (in category 'utilitity') -----
+ findAnythingMorph
+ 
+ 	^ FileList2 morphicViewProjectLoader2InWorld: ActiveWorld
+ 		title: 'Find...' translated
+ 		reallyLoad: true
+ 		dirFilterType: #initialDirectoryList
+ 		isGeneral: true.!

Item was added:
+ ----- Method: SugarNavigatorBar class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"self initialize"
+ 	Preferences addPreference: #showAdvancedNavigatorButtons 
+ 		categories: #(morphic)
+ 		default: false
+ 		balloonHelp: 'If true, an advanced version of the navigator is shown, otherwise a simplified version.'
+ 		projectLocal: false
+ 		changeInformee: self
+ 		changeSelector: #rebuildButtons.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar class>>newWith: (in category 'instance creation') -----
+ newWith: aSugarLibObject
+ 
+ 	^ self new sugarLib: aSugarLibObject.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar class>>putUpInitialBalloonHelp (in category 'utilitity') -----
+ putUpInitialBalloonHelp
+ 
+ 	| flap |
+ 	flap _ Flaps globalFlapTabWithID: 'Sugar Navigator Flap' translated.
+ 	flap ifNil: [^ self].
+ 	(flap referent isMemberOf: SugarNavigatorBar) ifFalse: [^ self].
+ 	flap referent putUpInitialBalloonHelp
+ !

Item was added:
+ ----- Method: SugarNavigatorBar class>>rebuildButtons (in category 'utilitity') -----
+ rebuildButtons
+ 	self current ifNotNilDo: [:bar | bar rebuildButtons]!

Item was added:
+ ----- Method: SugarNavigatorBar class>>refreshButRetainOldContents (in category 'instance creation') -----
+ refreshButRetainOldContents
+ "
+ 	SugarNavigatorBar refreshButRetainOldContents
+ "
+ 	| supplies objects nav nonStandard color highlight height |
+ 	nav _ Flaps globalFlapTabWithID: 'Sugar Navigator Flap' translated.
+ 	nav ifNotNil: [
+ 		nonStandard _ nav nonStandardMorphs.
+ 		color _ nav referent color.
+ 		highlight _ nav referent highlightColor.
+ 		height _ nav referent height.
+ 	] ifNil: [
+ 		nonStandard _ #().
+ 		color _ nil.
+ 		highlight _ nil.
+ 		height _ nil].
+ 	supplies _ Flaps globalFlapTabWithID: 'Supplies' translated.
+ 	supplies ifNotNil: [supplies _ supplies referent].
+ 	(supplies isMemberOf: PartsBin) ifTrue: [objects _ supplies savedUserDefinedObjects] ifFalse: [objects _ nil].
+ 
+ 	Flaps disableGlobalFlaps: false.
+ 	Flaps enableEToyFlaps.
+ 	nav _ Flaps globalFlapTabWithID: 'Sugar Navigator Flap' translated.
+ 	nonStandard ifNotNil: [
+ 		nonStandard do: [:p |
+ 			nav addMorphFront: p first.
+ 			p first position: (nav position + p second)
+ 		]
+ 	].
+ 	(color notNil and: [highlight notNil and: [height notNil]]) ifTrue: [nav referent color: color highLightColor: highlight. nav naviHeight: height].
+ 	objects ifNotNil: [
+ 		supplies _ Flaps globalFlapTabWithID: 'Supplies' translated.
+ 		supplies ifNotNil: [supplies _ supplies referent].
+ 		(supplies isMemberOf: PartsBin) ifTrue: [supplies restoreUserDefinedObjectsFrom: objects].
+ 	]!

Item was added:
+ ----- Method: SugarNavigatorBar class>>showHideButton (in category 'preferences') -----
+ showHideButton
+ 	
+ 	<preference: 'Show a button to hide the Sugar navigator bar inside the bar'
+ 		category: 'docking bars'
+ 		description: 'Whether the hide bar button is shown in the Sugar navigator bar'
+ 		type: #Boolean>
+ 	^ ShowHideButton ifNil: [ShowHideButton := false]!

Item was added:
+ ----- Method: SugarNavigatorBar class>>showHideButton: (in category 'preferences') -----
+ showHideButton: aBoolean
+ 	
+ 	ShowHideButton := aBoolean.
+ 	self showSugarNavigator: self showSugarNavigator. "re-init"!

Item was added:
+ ----- Method: SugarNavigatorBar class>>showSugarNavigator (in category 'preferences') -----
+ showSugarNavigator
+ 	
+ 	<preference: 'Show Sugar navigator bar'
+ 		category: 'docking bars'
+ 		description: 'Whether the EToys Sugar navigator bar is shown. Disables the world main docking bar.'
+ 		type: #Boolean>
+ 	^ ShowSugarNavigator ifNil: [ShowSugarNavigator := false]!

Item was added:
+ ----- Method: SugarNavigatorBar class>>showSugarNavigator: (in category 'preferences') -----
+ showSugarNavigator: aBoolean
+ 	
+ 	ShowSugarNavigator := aBoolean.
+ 	Smalltalk at: #TheWorldMainDockingBar ifPresent: [:class | class showWorldMainDockingBar: aBoolean not].
+ 	Project current updateLocaleDependents.!

Item was added:
+ ----- Method: SugarNavigatorBar class>>supplementaryPartsDescriptions (in category 'utilitity') -----
+ supplementaryPartsDescriptions
+ 	^ {DescriptionForPartsBin
+ 		formalName: 'File Dialog' translatedNoop
+ 		categoryList: #('Scripting')
+ 		documentation: 'The list of files and directories' translatedNoop
+ 		globalReceiverSymbol: #SugarNavigatorBar
+ 		nativitySelector: #findAnythingMorph
+ 	}!

Item was added:
+ ----- Method: SugarNavigatorBar>>addButtons (in category 'initialization') -----
+ addButtons
+ 
+ 	super addButtons.
+ 	self wantsHaloForSubmorphs: Preferences eToyFriendly not.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>availableDisplayModes (in category 'buttons creation') -----
+ availableDisplayModes
+ 	"Answer an array of available screen modes.  The full-screen item is not included now."
+ 
+ 	| ret actual desired |
+ 	ret _ OrderedCollection new: 3.
+ 	ret add: #physical.
+ 	actual _ DisplayScreen actualScreenSize.
+ 	desired _ OLPCVirtualScreen virtualScreenExtent.
+ 	actual = desired ifTrue: [^ ret].
+ 	ret add: #scaledVirtual.
+ 	(actual x > desired x and: [actual y > desired y]) ifTrue:
+ 		[ret add: #centeredVirtual].
+ 
+ 	^ ret asArray!

Item was added:
+ ----- Method: SugarNavigatorBar>>balloonTextForMode: (in category 'buttons creation') -----
+ balloonTextForMode: aMode
+ 	"Answer the (English) balloon text associated with a display-mode choice."
+ 
+ 	aMode = #physical ifTrue:
+ 		[^ 'Use the normal Squeak display, without applying any special scaling.' translated].
+ 	aMode = #scaledVirtual ifTrue:
+ 		[^ 'Scale the Squeak display so that it appears to have the same resolution as an OLPC display.  If you resize the Squeak window to approximate the physical dimensions of the real OLPC display, this will result in an appearance that closely resembles the appearance on an OLPC screen.' translated].
+ 	aMode = #centeredVirtual ifTrue:
+ 		[^ 'Present a virtual display that approximates the actual OLPC display in resolution, centered within the actual Squeak display window.' translated].
+ 	^ nil!

Item was added:
+ ----- Method: SugarNavigatorBar>>buildAndOpenHelpFlap (in category 'help flap') -----
+ buildAndOpenHelpFlap
+ 	"Called only when flaps are being created afresh."
+ 
+ 	| aFlapTab outer leftStrip rightStrip aGuide |
+ 	aFlapTab :=  FlapTab new.
+ 	aFlapTab assureExtension visible: false.
+ 	aFlapTab setProperty: #rigidThickness toValue: true.
+ 
+ 	outer := AlignmentMorph newRow.
+ 	outer assureExtension visible: false.
+ 	outer clipSubmorphs: true.
+ 	outer beTransparent.
+ 	outer vResizing: #spaceFill; hResizing: #spaceFill.
+ 	outer layoutInset: 0; cellInset: 0; borderWidth: 0.
+ 	outer setProperty: #wantsHaloFromClick toValue: false.
+ 
+ 	leftStrip := Morph new beTransparent.  "This provides space for tabs to be seen."
+ 	leftStrip layoutInset: 0; cellInset: 0; borderWidth: 0.
+ 	leftStrip width:  20.
+ 	leftStrip hResizing: #rigid; vResizing: #spaceFill.
+ 	outer addMorphBack: leftStrip.   
+ 
+ 	rightStrip := AlignmentMorph newColumn.
+ 	rightStrip color: (Color green veryMuchLighter alpha:  0.2).
+ 	rightStrip layoutInset: 0; cellInset: 0; borderWidth: 0.
+ 	rightStrip setProperty: #wantsHaloFromClick toValue: false.
+ 	outer addMorphBack: rightStrip.
+ 	outer clipSubmorphs: true.
+ 	
+ 	aGuide := QuickGuideMorph new.
+ 	aGuide initializeIndexPage.
+ "	aGuide order: QuickGuideMorph defaultOrder.	"
+ 	QuickGuideMorph loadIndexAndPeekOnDisk.
+ 	aGuide loadPages.
+ 	rightStrip addMorphBack: aGuide.
+ 	aGuide beSticky.
+ 
+ 	aFlapTab referent ifNotNil: [aFlapTab referent delete].
+ 	aFlapTab referent: outer.
+ 	aFlapTab setName: 'Help' translated edge: #left color: (Color r: 0.677 g: 0.935 b: 0.484).
+ 	ActiveWorld addMorphFront: aFlapTab.
+ 	aFlapTab adaptToWorld: ActiveWorld.
+ 	aFlapTab computeEdgeFraction.
+ 
+ 	aFlapTab position: (outer left @ outer top).
+ 	outer extent: (462 @ ActiveWorld height).
+ 
+ 	outer beFlap: true.
+ 	outer beTransparent.
+ 
+ 	aFlapTab referent hide.
+ 	aFlapTab referentMargin: 0 at self height.
+ 	aFlapTab openFully.
+ 
+ 	outer beSticky.
+ 	leftStrip beSticky.
+ 	rightStrip beSticky.
+ 
+ 	aFlapTab applyThickness: 462.
+ 	aFlapTab fitOnScreen.
+ 	aFlapTab referent show.
+ 	aFlapTab show.
+ 	aFlapTab makeFlapCompact: true.
+ 	aFlapTab setToPopOutOnDragOver:  false.
+ 	Flaps addGlobalFlap: aFlapTab.
+ 	ActiveWorld addGlobalFlaps.
+ 	ScriptingSystem cleanUpFlapTabsOnLeft!

Item was added:
+ ----- Method: SugarNavigatorBar>>buttonChoose (in category 'buttons creation') -----
+ buttonChoose
+ 	"Answer a button for choosing objects from the Journal"
+ 
+ 	^ self makeButton: 'FIND' translated balloonText: 'Find an entry in the Journal.  Hold mouse button down for further options.' translated for: #chooseObject
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>buttonHeight (in category 'accessing') -----
+ buttonHeight
+ 
+ 	^ paintButton ifNotNil: [paintButton height] ifNil: [75].
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>buttonHideNavBar (in category 'buttons creation') -----
+ buttonHideNavBar
+ 	"Build and return a fresh HideNavBarButton"
+ 
+ 	^ self makeButton: 'hideNavBar' balloonText: 'hide the tool bar' translated for: #hideNavBar
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>buttonKeep (in category 'buttons creation') -----
+ buttonKeep
+ 	"Answer a button for saving the project in the Journal"
+ 	^ self makeButton: 'PUBLISH IT!!' translated balloonText:  'Keep a copy of the current project in the Journal. Hold mouse button down for further options.' translated for: #keepProject!

Item was added:
+ ----- Method: SugarNavigatorBar>>buttonLanguage (in category 'buttons creation') -----
+ buttonLanguage
+ 	"Build and return a fresh Undo button for me."
+ 
+ 	^ self makeButton: 'language' balloonText: 'Click here to choose your language.' translated for: #chooseLanguage
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>buttonPaint (in category 'buttons creation') -----
+ buttonPaint
+ 	"Build and return a fresh Undo button for me."
+ 
+ 	^paintButton := self makeButton: 'paint' balloonText: 'Make a painting' translated for: #doNewPainting
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>buttonShare (in category 'buttons creation') -----
+ buttonShare
+ 	"Answer an new instance of a 'Share' button."
+ 
+ 	^ shareButton _ self makeButton: 'Share' 
+ 		balloonText: 'Enable sharing. When another user joins, you can exchange objects.' translated 
+ 		for: #shareMenu!

Item was added:
+ ----- Method: SugarNavigatorBar>>buttonShowNavBar (in category 'buttons creation') -----
+ buttonShowNavBar
+ 	"Build and return a fresh button for showing the nav-bar."
+ 
+ 	^ self makeButton: 'showNavBar' balloonText: 'show the tool bar' translated for: #showNavBar
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>buttonStop (in category 'buttons creation') -----
+ buttonStop
+ 
+ 	^self makeButton: 'stop' balloonText: 'Quit Etoys (with saving)' translated for: #stopSqueak
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>buttonUndo (in category 'buttons creation') -----
+ buttonUndo
+ 	"Build and return a fresh Undo button for me."
+ 
+ 	undoButton _ self makeButton: 'undo' balloonText: 'Undo the last change' translated for: #undoOrRedoLastCommand.
+ 	^ undoButton.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>buttonZoom (in category 'buttons creation') -----
+ buttonZoom
+ 	"Build and return a fresh Zoom button for me."
+ 
+ 	^self makeButton: 'zoom' balloonText: 'Click here to toggle using the full screen.' translated for: #zoom
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>changeDisplayModeTo: (in category 'button actions') -----
+ changeDisplayModeTo: aSymbol
+ 	"If the user's display mode is not already the one indicated by the input parameter, switch to that mode."
+ 
+ 	aSymbol == #physical ifTrue: [
+ 		OLPCVirtualScreen virtualScreenExtent: nil.
+ 		^ OLPCVirtualScreen unInstall.
+ 	].
+ 	aSymbol == #scaledVirtual ifTrue: [
+ 		^ OLPCVirtualScreen install.
+ 	].
+ 	aSymbol == #centeredVirtual ifTrue: [
+ 		OLPCVirtualScreen install.
+ 		^ Display zoomOut: true.
+ 	].!

Item was added:
+ ----- Method: SugarNavigatorBar>>changeVirtualScreenMode (in category 'button actions') -----
+ changeVirtualScreenMode
+ 
+ 	Display isVirtualScreen ifTrue: [
+ 		(Display canZoomOut) ifTrue: [
+ 			Display zoomOut not ifTrue: [Display zoomOut: true. ^ self].
+ 		].
+ 		Display unInstall.
+ 		^ self.
+ 	].
+ 	OLPCVirtualScreen install.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>checkForResize (in category 'morphic interaction') -----
+ checkForResize
+ 	"Check to see if the receiver needs to be reconfigured because of a world resize."
+ 
+ 	| shouldResize h worldBounds inset |
+ 	(owner isKindOf: SugarNavTab) ifFalse: [^ self].  "e.g. being held by hand."
+ 	owner edgeToAdhereTo = #topRight ifTrue: [^ owner occupyTopRightCorner]. 
+ 
+ 	shouldResize _ false.
+ 	worldBounds _ self world bounds.
+ 	(self layoutInset ~= (inset _ SugarLauncher isRunningInSugar ifTrue: [75 at 0] ifFalse: [0 at 0]))
+ 		ifTrue: [self layoutInset: inset].
+ 	worldBounds width ~= self width ifTrue: [shouldResize _ true].
+ 	Preferences useArtificialSweetenerBar ifTrue: [
+ 		h _ submorphs first submorphs first height.
+ 		(worldBounds extent x >= 1200 and: [worldBounds extent y >= 900]) ifTrue: [
+ 			h = 40 ifTrue: [self naviHeight: 75. shouldResize _ true]]
+ 		ifFalse: [h = 75 ifTrue: [self naviHeight: 40. shouldResize _ true]]].
+ 	(h _ self submorphBounds height) ~= self height ifTrue: [shouldResize _ true].
+ 	(owner notNil and: [owner isFlapTab]) ifTrue: [
+ 		owner edgeToAdhereTo == #top ifTrue: [
+ 			self topLeft ~= worldBounds topLeft ifTrue: [shouldResize _ true].
+ 		]. 
+ 		owner edgeToAdhereTo == #bottom ifTrue: [
+ 			self bottomLeft ~= worldBounds bottomLeft ifTrue: [shouldResize _ true].
+ 		]. 
+ 		shouldResize ifTrue: [
+ 			owner edgeToAdhereTo == #top ifTrue: [
+ 				self bounds: (0 at 0 corner: (worldBounds width at h)).
+ 			].
+ 			owner edgeToAdhereTo == #bottom ifTrue: [
+ 				self bounds: (0@(worldBounds height - h) corner: (worldBounds bottomRight)).
+ 			].
+ 			self resizeProjectNameField.
+ 			owner layoutChanged.
+ 		].
+ 	].!

Item was added:
+ ----- Method: SugarNavigatorBar>>checkSugarButtons (in category 'initialization') -----
+ checkSugarButtons
+ 	| wasSugar |
+ 	(owner hasProperty: #collapsedMode) ifTrue: [^self].
+ 	wasSugar := paintButton owner submorphs anySatisfy:
+ 		[:e | e isButton and: [e actionSelector = #chooseObject]].
+ 	isSugar := SugarLauncher current isRunningInSugar.
+ 	wasSugar = isSugar ifFalse: [self rebuildButtons].
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>chooseObject (in category 'button actions') -----
+ chooseObject
+ 	SugarLauncher current chooseObject!

Item was added:
+ ----- Method: SugarNavigatorBar>>chooseScreenSetting (in category 'buttons creation') -----
+ chooseScreenSetting
+ 	"Put up a menu allowing the user to choose between virtual-olpc-display mode and normal-display mode."
+ 
+ 	| aMenu availableModes |
+ 	aMenu _ MenuMorph new defaultTarget: self.
+ 	aMenu addTitle: 'display mode' translated.
+ 	Preferences noviceMode
+ 		ifFalse: [aMenu addStayUpItem].
+ 
+ 	availableModes _ self availableDisplayModes.
+ 
+ 	availableModes do:
+ 		[:mode |
+ 			aMenu addUpdating: #stringForDisplayModeIs: target: self selector: #toggleScreenSetting: argumentList: {mode}.
+ 			(self balloonTextForMode: mode) ifNotNilDo:
+ 				[:help |
+ 					aMenu balloonTextForLastItem: help translated]].
+ 	aMenu addLine.
+ 	aMenu addUpdating: #stringForFullScreenToggle  target: self action: #toggleFullScreen.
+ 	aMenu popUpInWorld
+ 
+ "(Flaps globalFlapTabWithID: 'Sugar Navigator Flap' translated) referent chooseScreenSetting"!

Item was added:
+ ----- Method: SugarNavigatorBar>>color: (in category 'accessing') -----
+ color: aColor
+ 
+ 	| oldHeight |
+ 	color = aColor ifTrue: [^ self].
+ 	oldHeight _ self buttonHeight.
+ 	super color: aColor.
+ 	submorphs ifNotEmpty: [self rebuildButtons].
+ 	self buttonHeight ~= oldHeight ifTrue: [
+ 		self naviHeight: oldHeight.
+ 	].
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>color:highLightColor: (in category 'accessing') -----
+ color: baseColor highLightColor: hColor
+ 
+ 	| oldHeight |
+ 	oldHeight _ self buttonHeight.
+ 	(color = baseColor and: [highLightColor = hColor]) ifTrue: [^ self].
+ 	super color: baseColor.
+ 	highLightColor _ hColor.
+ 	submorphs ifNotEmpty: [self rebuildButtons].
+ 	self buttonHeight ~= oldHeight ifTrue: [
+ 		self naviHeight: oldHeight.
+ 	].
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>configureForSqueakland (in category 'initialization') -----
+ configureForSqueakland
+ 	"Formerly -- have a narrow, green bar.  Now:  just use the standard."
+ 
+ 	"self naviHeight: 40.
+ 	self color: Color green muchDarker highLightColor: Color green darker."!

Item was added:
+ ----- Method: SugarNavigatorBar>>currentDisplayMode (in category 'button actions') -----
+ currentDisplayMode
+ 
+ 	Display isVirtualScreen ifTrue: [
+ 		(Display canZoomOut) ifTrue: [
+ 			Display zoomOut ifTrue: [^ #centeredVirtual]].
+ 		^ #scaledVirtual
+ 	].
+ 	^ #physical
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>doNewPainting (in category 'button actions') -----
+ doNewPainting
+ 	
+ 	| w |
+ 
+ 	w _ self world.
+ 	w assureNotPaintingElse: [^ self].
+ 	w makeNewDrawing: (self primaryHand lastEvent copy setPosition: w center)
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>doZoomButtonMenuEvent: (in category 'button actions') -----
+ doZoomButtonMenuEvent: evt
+ 
+ 	self chooseScreenSetting
+ 
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>getBadge (in category 'sharing') -----
+ getBadge
+ 
+ 	SugarBuddy fromMesh!

Item was added:
+ ----- Method: SugarNavigatorBar>>gotoAnother (in category 'the actions') -----
+ gotoAnother
+ 
+ 	EToyProjectHistoryMorph new
+ 		position: ActiveHand position;
+ 		openInWorld
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>handlesMouseOver: (in category 'event handling') -----
+ handlesMouseOver: evt
+ 
+ 	^ false.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>hideNavBar (in category 'button actions') -----
+ hideNavBar
+ 	"Reconfigure the nav-bar such that it only shows the 'show nav bar' icon at right edge"
+ 
+ 	owner hideNavBar!

Item was added:
+ ----- Method: SugarNavigatorBar>>highLightColor (in category 'accessing') -----
+ highLightColor
+ 
+ 	^ highLightColor.
+ 
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>highLightColor: (in category 'accessing') -----
+ highLightColor: aColor
+ 
+ 	| oldHeight |
+ 	highLightColor = aColor ifTrue: [^ self].
+ 	highLightColor _ aColor.
+ 	oldHeight _ self buttonHeight.
+ 	submorphs ifNotEmpty: [self rebuildButtons].
+ 	self buttonHeight ~= oldHeight ifTrue: [
+ 		self naviHeight: oldHeight.
+ 	].
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>inAColumn: (in category 'initialization') -----
+ inAColumn: aCollectionOfMorphs
+ 
+ 	^ aCollectionOfMorphs at: 1.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>inARow: (in category 'initialization') -----
+ inARow: aCollectionOfMorphs
+ 	"Answer a row morph with the given collection as its submorphs.  Interpret the symbol #spacer in the incoming list as a request for a variable transparent spacer."
+ 
+ 	^ (Morph inARow: aCollectionOfMorphs) setProperty: #wantsHaloFromClick toValue: false.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	super initialize.
+ 	self layoutInset: 0 at 0;
+ 	  hResizing: #rigid;
+ 	  vResizing: #rigid;
+ 	  cellPositioning: #topLeft.
+ 	self cornerStyle: #square.
+ 	self resistsRemoval: true.
+ 	self beSticky.
+ 	self makeGray.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>isSugar (in category 'accessing') -----
+ isSugar
+ 	^isSugar == true!

Item was added:
+ ----- Method: SugarNavigatorBar>>joinSharedActivity (in category 'sharing') -----
+ joinSharedActivity
+ 	self startP2P.
+ 	self sharingChanged.!

Item was added:
+ ----- Method: SugarNavigatorBar>>keepProject (in category 'the actions') -----
+ keepProject
+ 	Preferences sugarAutoSave
+ 		ifTrue: [SugarLauncher current save]
+ 		ifFalse: [self publishProject]
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>makeBadgeLabelIn: (in category 'the actions') -----
+ makeBadgeLabelIn: aPoint
+ 
+ 	| aMorph icon string |
+ 	aMorph _ Morph new.
+ 	aMorph extent: aPoint.
+ 	aMorph color: Color transparent.
+ 	
+ 	icon _ SketchMorph new form: (SugarLibrary default imageFor: 'miniShare' color: self color).
+ 	string _ StringMorph new label: 'Make a Badge' translated font: Preferences standardEToysFont.
+ 	string color: Color white.
+ 
+ 	icon center: (icon width // 2)@(aPoint y // 2).
+ 	string center: (icon width // 2)@(aPoint y // 2).
+ 	string left: icon right + 1.
+ 	aMorph addMorph: icon.
+ 	aMorph addMorph: string.
+ 	^ aMorph.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>makeButton:balloonText:for: (in category 'buttons creation') -----
+ makeButton: aString balloonText: anotherString for: aSymbol
+ 	"Make a button indexed by the string, with the given balloon text; the third parameter indicates the action selector to be associated with the button."
+ 
+ 	^ self sugarLib makeButton: aString balloonText: anotherString for: aSymbol target: self baseColor: color highLightColor: highLightColor
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>makeGray (in category 'accessing') -----
+ makeGray
+ 
+ 	self color: (Color r: 0.258 g: 0.258 b: 0.258) highLightColor: Color black.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>makeGreen (in category 'accessing') -----
+ makeGreen
+ 
+ 	self color: (Color r: 0.258 g: 0.613 b: 0.161) highLightColor: (Color r: 0.157 g: 0.372 b: 0.098).
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>makeMyNeighborhoodLabelIn: (in category 'the actions') -----
+ makeMyNeighborhoodLabelIn: aPoint
+ 
+ 	| aMorph icon string |
+ 	aMorph _ Morph new.
+ 	aMorph extent: aPoint.
+ 	aMorph color: Color transparent.
+ 	
+ 	icon _ SketchMorph new form: (SugarLibrary default imageFor: 'miniShare' color: self color).
+ 	string _ StringMorph new label: 'My Neighborhood' translated font: Preferences standardEToysFont.
+ 	string color: Color white.
+ 
+ 	icon center: (icon width // 2)@(aPoint y // 2).
+ 	string center: (icon width // 2)@(aPoint y // 2).
+ 	string left: icon right + 1.
+ 	aMorph addMorph: icon.
+ 	aMorph addMorph: string.
+ 	^ aMorph.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>makePrivateLabelIn: (in category 'the actions') -----
+ makePrivateLabelIn: aPoint
+ 
+ 	| aMorph icon string |
+ 	aMorph _ Morph new.
+ 	aMorph extent: aPoint.
+ 	aMorph color: Color transparent.
+ 	
+ 	icon _ SketchMorph new form: (SugarLibrary default imageFor: 'miniPrivate' color: self color).
+ 	string _ StringMorph new label: 'Private' translated font: Preferences standardEToysFont.
+ 	string color: Color white.
+ 
+ 	icon center: (icon width // 2)@(aPoint y // 2).
+ 	string center: (icon width // 2)@(aPoint y // 2).
+ 	string left: icon right + 1.
+ 	aMorph addMorph: icon.
+ 	aMorph addMorph: string.
+ 	^ aMorph.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>makeProjectNameLabel (in category 'the actions') -----
+ makeProjectNameLabel
+ 
+ 	| t |
+ 	projectNameField _ SugarRoundedField new.
+ 	t _ UpdatingStringMorph new.
+ 	t setProperty: #okToTextEdit toValue: true.
+ 	t putSelector: #projectNameChanged:.
+ 	t getSelector: #projectName.
+ 	projectNameField backgroundColor: self color.
+ 	t target: self.
+ 	t useStringFormat.
+ 	t beSticky.
+ 	t label: ActiveWorld project name font: (StrikeFont familyName: 'BitstreamVeraSans' size: 24).
+ 	t color: Color black.
+ 	t width: projectNameField width - 10.
+ 	projectNameField label: t.
+ 	projectNameField setBalloonText: self projectNameFieldBalloonHelp.
+ 	projectNameField on: #mouseDown send: #mouseDown: to: t.
+ 	projectNameField on: #mouseUp send: #mouseUp: to: t.
+ 	self resizeProjectNameField.
+ 	^projectNameField.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>makeTheButtons (in category 'initialization') -----
+ makeTheButtons
+ 
+ 	^ (Smalltalk globals at: #SExpElement
+ 		ifPresent: [:c | {self buttonHelp}]
+ 		ifAbsent: [{}]),
+ 	{
+ 		self makeProjectNameLabel.
+ 	},
+ 	(
+ 		Preferences showAdvancedNavigatorButtons
+ 			ifTrue: [{self buttonNewProject. self buttonGoTo}]
+ 			ifFalse: [#()]
+ 	),
+ 	{
+ 		self buttonPrev.
+ 		self buttonNext.
+ 		self buttonPaint.
+ 		self buttonSupplies.
+ 		self buttonLanguage.
+ 	}, 
+ 	(SugarLauncher isRunningInSugar
+ 		ifTrue: [{
+ 			self buttonShare.
+ 			#spacer.
+ 			self buttonChoose.
+ 			self buttonKeep.
+ 			stopButton := SugarLauncher current willSaveOnQuit
+ 				ifTrue: [self buttonStop]
+ 				ifFalse: [self buttonQuit]	}]
+ 		ifFalse: [{
+ 			self buttonZoom.
+ 			#spacer.
+ 			self buttonFind.
+ 			self buttonPublish.
+ 			self buttonQuit}]
+ 	),
+ 	(SugarNavigatorBar showHideButton
+ 		ifTrue: [{self buttonHideNavBar}]
+ 		ifFalse: [#()])!

Item was added:
+ ----- Method: SugarNavigatorBar>>morphicLayerNumber (in category 'event handling') -----
+ morphicLayerNumber
+ 
+ 	^ 100.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>naviHeight: (in category 'morphic interaction') -----
+ naviHeight: anInteger
+ 
+ 	anInteger > self height ifTrue: [^ self naviHeightWithFullUpdate: anInteger].
+ 	anInteger < 2 ifTrue: [^ self].
+ 	submorphs isEmpty ifTrue: [^ super extent: self width at anInteger].
+ 	self resizeButtonsAndTabTo: anInteger.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>naviHeightWithFullUpdate: (in category 'morphic interaction') -----
+ naviHeightWithFullUpdate: anInteger
+ 
+ 	submorphs isEmpty ifTrue: [^ super extent: self width at anInteger].
+ 	self rebuildButtons.
+ 	self resizeButtonsAndTabTo: anInteger.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>newProject (in category 'the actions') -----
+ newProject
+ 	MorphicProject new enter!

Item was added:
+ ----- Method: SugarNavigatorBar>>oldHeight (in category 'accessing') -----
+ oldHeight
+ 
+ 	^ paintButton ifNotNil: [paintButton height] ifNil: [75].
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>paintButtonInitialExplanation (in category 'initialization') -----
+ paintButtonInitialExplanation
+ 
+ 	^ 'To start,
+ click here
+ to create
+ a new
+ painting.' translated
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>previousProject (in category 'the actions') -----
+ previousProject
+ 	Preferences eToyFriendly ifTrue: [
+ 		| prev |
+ 		prev := Project current previousProject.
+ 		(prev isNil or: [prev isTopProject]) ifTrue: [
+ 			Project home ifNotNilDo: [:p | Project current setParent: p]]].
+ 	super previousProject!

Item was added:
+ ----- Method: SugarNavigatorBar>>projectName (in category 'the actions') -----
+ projectName
+ 
+ 	^ ActiveWorld project name.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>projectNameChanged: (in category 'the actions') -----
+ projectNameChanged: aString
+ 
+ 	ActiveWorld project renameTo: aString.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>projectNameFieldBalloonHelp (in category 'the actions') -----
+ projectNameFieldBalloonHelp
+ 
+ 	^ 'This is the name of current project.
+ You can edit it as well.' translated.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>putUpInitialBalloonHelp (in category 'initialization') -----
+ putUpInitialBalloonHelp
+ "
+ 	SugarNavigatorBar putUpInitialBalloonHelp
+ "
+ 
+ 	| suppliesButton b1 b2 p b |
+ 	suppliesButton _ paintButton owner submorphs detect: [:e | e isButton and: [e actionSelector = #toggleSupplies]].
+ 
+ 	b1 _ BalloonMorph string: self paintButtonInitialExplanation for: paintButton corner: #topRight force: false.
+ 	b2 _ BalloonMorph string: self suppliesButtonInitialExplanation for: suppliesButton corner: #topLeft force: true.
+ 
+ 	p _ PasteUpMorph new.
+ 	p clipSubmorphs: false.
+ 	p color: Color transparent.
+ 	p borderWidth: 0.
+ 	p addMorph: b1.
+ 	p addMorph: b2.
+ 	b _ BalloonMorph string: p for: World corner: #bottomLeft.
+ 	b color: Color transparent.
+ 	b borderWidth: 0.
+ 	[(Delay forSeconds: 1) wait. b popUpForHand: ActiveHand] fork.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>putUpInitialBalloonHelpFor: (in category 'initialization') -----
+ putUpInitialBalloonHelpFor: quads
+ 	"Given a list of quads of the form <selector> <help-msg> <corner> <force-boolean> (see senders for examples), put up initial balloon help for them."
+ "
+ 	SugarNavigatorBar someInstance putUpInitialBalloonHelpFor: #((doNewPainting 'make a new painting' topRight false) (toggleSupplies 'open the supplies bin' topLeft true))
+ 	SugarNavigatorBar someInstance putUpInitialBalloonHelpFor: #((showNavBar 'show the tool bar' bottomLeft false) (hideNavBar 'hide the tool bar' bottomLeft false))
+ 
+ "
+ 	|  b1 p b |
+ 
+ 	p _ PasteUpMorph new.
+ 	p clipSubmorphs: false.
+ 	p color: Color transparent.
+ 	p borderWidth: 0.
+ 
+ 	quads do: [:aQuad |
+ 		(submorphs first submorphs detect: [:e | e isButton and: [e actionSelector = aQuad first]] ifNone: [nil]) ifNotNilDo:
+ 			[:aButton |
+ 				b1 := BalloonMorph string: aQuad second for: aButton corner: aQuad third force: aQuad fourth.
+ 				p addMorph: b1]].
+ 
+ 	b _ BalloonMorph string: p for: World corner: #bottomLeft.
+ 	b color: Color transparent.
+ 	b borderWidth: 0.
+ 	[(Delay forSeconds: 1) wait. b popUpForHand: ActiveHand] fork.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>quitSqueak (in category 'button actions') -----
+ quitSqueak
+ 	^SugarLauncher isRunningInSugar
+ 		ifTrue: [SugarLauncher current quit]
+ 		ifFalse: [super quitSqueak].
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>rebuildButtons (in category 'initialization') -----
+ rebuildButtons
+ 	(owner notNil and: [owner hasProperty: #collapsedMode]) 
+ 		ifTrue:[^self].
+ 	submorphs do: [:e | e delete].
+ 			self addButtons !

Item was added:
+ ----- Method: SugarNavigatorBar>>resizeButtonsAndTabTo: (in category 'morphic interaction') -----
+ resizeButtonsAndTabTo: newDim
+ 	"Resize the receiver's buttons and containing tab to conform to the given dimension."
+ 
+ 	| frame |
+ 	submorphs ifNotEmpty:
+ 		[frame := submorphs first.
+ 		frame submorphs do: [:e |
+ 			e naviHeight: newDim].
+ 		frame height: newDim.
+ 		supplies ifNotNil:
+ 			[supplies naviHeight: newDim]]!

Item was added:
+ ----- Method: SugarNavigatorBar>>resizeProjectNameField (in category 'the actions') -----
+ resizeProjectNameField
+ 
+ 	"The height should be 45 according to the Sugar guilde line, but an odd number makes the circle distorted.  To be general, it uses 60% of the height of bar."
+ 	| h |
+ 	h _ (self height * 0.6) roundTo: 2.
+ 	projectNameField ifNotNil: [
+ 		projectNameField extent: (Display width >= 1200 ifTrue: [220] ifFalse: [130])@h.
+ 		projectNameField resizeLabel].!

Item was added:
+ ----- Method: SugarNavigatorBar>>setEdge: (in category 'event handling') -----
+ setEdge: aSymbol
+ 	"Establish the given edge to which to cling."
+ 
+ 	(Flaps globalFlapTab: 'Supplies' translated) ifNotNilDo:
+ 		[:s | s setEdge: aSymbol]!

Item was added:
+ ----- Method: SugarNavigatorBar>>setSuppliesBehind (in category 'initialization') -----
+ setSuppliesBehind
+ 
+ 	supplies ifNotNil: [supplies referent setProperty: #wantsToBeTopmost toValue: false].
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>setupSuppliesFlap (in category 'buttons creation') -----
+ setupSuppliesFlap
+ 
+ 	| i f |
+ 	sugarLib ifNil: [^ self].
+ 	supplies _ Flaps globalFlapTabWithID: 'Supplies' translated.
+ 	supplies ifNotNil: [
+ 		i _ sugarLib imageFor: 'supplies' color: color.
+ 		f _ Form extent: 75 at 75 depth: 16.
+ 		f fillColor: color.
+ 		i displayOn: f at: (f extent - i extent)//2 rule: Form over.
+ 		supplies sugarNavTab: self icon: f.
+ 	].
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>shareMenu (in category 'the actions') -----
+ shareMenu
+ 
+ 	| menu item ext |
+ 	menu _ MenuMorph new.
+ 	ext _ 200 at 50.
+ 	#((stopSharing makePrivateLabelIn:) (startSharing makeMyNeighborhoodLabelIn:) "(shareThisWorld makeBadgeLabelIn:)") do: [:pair |
+ 		
+ 		item _ MenuItemMorph new
+ 			contents: '';
+ 			target: self;
+ 			selector: pair first;
+ 			arguments: #().
+ 		item color: Color black.
+ 		item addMorph: (self perform: pair second with: ext).
+ 		item setProperty: #minHeight toValue: ext y.
+ 		item fitContents.
+ 		item extent: ext.
+ 		item setProperty: #selectionFillStyle toValue: (Color gray alpha: 0.5).
+ 		menu addMorphBack: item.
+ 	].
+ 	menu color: Color black.
+ 	menu borderColor: Color white.
+ 	^ menu invokeModalAt: shareButton position + (10 at 20) in: ActiveWorld allowKeyboard: false.!

Item was added:
+ ----- Method: SugarNavigatorBar>>shareThisWorld (in category 'button actions') -----
+ shareThisWorld
+ 
+ 	SugarLauncher current isShared ifFalse: [self startSharing].
+ 	self getBadge.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>sharingChanged (in category 'sharing') -----
+ sharingChanged
+ 	| state |
+ 	state := SugarLauncher current isShared
+ 		ifTrue: ['share']
+ 		ifFalse: ['private'].
+ 	SugarLibrary default recolorButton: shareButton for: state  baseColor: self color highLightColor: self highlightColor.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>showNavBar (in category 'event handling') -----
+ showNavBar
+ 	"Show the full sugar nav bar."
+ 
+ 	owner showNavBar!

Item was added:
+ ----- Method: SugarNavigatorBar>>showOnlyShowNavBarButton (in category 'morphic interaction') -----
+ showOnlyShowNavBarButton
+ 	"Reconfigure the receiver such that it only shows the show-nav-bar button"
+ 
+ 	self removeAllMorphs.
+ 	self addMorph: (self inARow:  {self buttonShowNavBar}).
+ 	self hResizing: #shrinkWrap.
+ 	Preferences useArtificialSweetenerBar ifTrue: [self configureForSqueakland].!

Item was added:
+ ----- Method: SugarNavigatorBar>>spacer: (in category 'buttons creation') -----
+ spacer: w
+ 
+ 	^ Morph new extent: w at 0; setProperty: #wantsHaloFromClick toValue: false; yourself
+ 
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>startNebraska (in category 'sharing') -----
+ startNebraska
+ 
+ 	| nebraska |
+ 	ActiveWorld remoteServer: nil.
+ 	ActiveWorld submorphs do: [:e | (e isMemberOf: NebraskaServerMorph) ifTrue: [e delete]].
+ 	nebraska := NebraskaServerMorph serveWorld.
+ 	SugarLauncher current
+ 		offerStreamTube: 'sqk-nebraska'
+ 		inBackgroundOnPort: [nebraska listeningPort].
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>startP2P (in category 'sharing') -----
+ startP2P
+ 	listener ifNotNil: [listener stopListening].
+ 	listener ifNil: [listener := SugarListenerMorph new].
+ 	listener position: -200 at -200.
+ 	ActiveWorld addMorphBack: listener.
+ 	listener startListening.
+ 	SugarLauncher current
+ 		offerStreamTube: 'sqk-etoy-p2p'
+ 		inBackgroundOnPort: [listener listeningPort].
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>startSharing (in category 'sharing') -----
+ startSharing
+ 	SugarLauncher current sharePublicly: true.
+ 	self joinSharedActivity.!

Item was added:
+ ----- Method: SugarNavigatorBar>>startUp (in category 'initialization') -----
+ startUp
+ 	self checkSugarButtons
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>step (in category 'morphic interaction') -----
+ step
+ 	self checkSugarButtons.
+ 	self checkForResize.
+ 	self undoButtonAppearance.
+ 	self stopButtonAppearance.!

Item was added:
+ ----- Method: SugarNavigatorBar>>stopButtonAppearance (in category 'event handling') -----
+ stopButtonAppearance
+ 	"Indicated whether stopping in Sugar will keep or not"
+ 	| wasStop isStop oldButton |
+ 	(self isSugar and: [stopButton notNil])  ifTrue: [
+ 		wasStop := stopButton actionSelector = #stopSqueak.
+ 		isStop := SugarLauncher current willSaveOnQuit.
+ 		wasStop = isStop ifFalse: [
+ 			oldButton := stopButton.
+ 			stopButton := isStop ifTrue: [self buttonStop] ifFalse: [self buttonQuit].
+ 			oldButton owner replaceSubmorph: oldButton by: stopButton]].
+ 
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>stopSharing (in category 'sharing') -----
+ stopSharing
+ 	SugarLauncher current leaveSharedActivity.
+ 	listener ifNotNil: [listener stopListening. listener _ nil].
+ 	ActiveWorld remoteServer: nil.
+ 	ActiveWorld submorphs do: [:e | (e isMemberOf: NebraskaServerMorph) ifTrue: [e delete]].
+ 	self sharingChanged.!

Item was added:
+ ----- Method: SugarNavigatorBar>>stopSqueak (in category 'button actions') -----
+ stopSqueak
+ 
+ 	^ self quitSqueak.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>stringForDisplayModeIs: (in category 'buttons creation') -----
+ stringForDisplayModeIs: aSymbol
+ 	"Answer the description of the scaling mode represented by the given symbol."
+ 
+ 	| currentMode |
+ 	currentMode := self currentDisplayMode.
+ 
+ 	#(	(physical			'No Scaling')
+ 		(scaledVirtual		'Scaled Virtual Extent')
+ 		(centeredVirtual	'Centered Virtual Extent'))  translatedNoop do:
+ 			[:pair |
+ 				aSymbol = pair first ifTrue:
+ 					[^  (currentMode = aSymbol ifTrue: ['<yes>'] ifFalse: ['<no>']), pair second translated]].
+ 
+ 
+ 	^ 'error'!

Item was added:
+ ----- Method: SugarNavigatorBar>>stringForFullScreenToggle (in category 'buttons creation') -----
+ stringForFullScreenToggle
+ 	"Answer the wording forf the full-screen toggle."
+ 
+ 	^ (self inFullScreenMode ifTrue: ['<yes>'] ifFalse: ['<no>']), 'Full Screen' translated!

Item was added:
+ ----- Method: SugarNavigatorBar>>sugarLib (in category 'accessing') -----
+ sugarLib
+ 	"Answer the instance of the SugarLibrary with which the receiver is affiliated, creating it at this time if necessary."
+ 
+ 	^ sugarLib ifNil: [sugarLib := SugarLibrary default]!

Item was added:
+ ----- Method: SugarNavigatorBar>>sugarLib: (in category 'initialization') -----
+ sugarLib: anObject
+ 
+ 	sugarLib _ anObject.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>suppliesButtonInitialExplanation (in category 'initialization') -----
+ suppliesButtonInitialExplanation
+ 
+ 	^ 'Or, click to see Supplies.  
+ Choose an object or 
+ choose the Object Catalog for more choices.' translated
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>toggleHelp (in category 'help flap') -----
+ toggleHelp
+ 	"Open the help-cards flap, or close it if open."
+ 
+ 	| ref f guide |
+ 	f _ Flaps globalFlapTab: 'Help' translated.
+ 	f ifNotNil:
+ 		[
+ 		f isInWorld
+ 			ifTrue:
+ 				[ref _ f referent.
+ 				ref ifNotNil: [guide _ ref findDeeplyA: QuickGuideMorph].
+ 				guide ifNotNil: [guide unloadPages].
+ 				Flaps removeFlapTab: f keepInList: false]
+ 			ifFalse:
+ 				[f openInWorld.
+ 				f showFlap.
+ 				ref _ f referent.
+ 				ref ifNotNil: [
+ 					guide _ ref findDeeplyA: QuickGuideMorph].
+ 					guide ifNotNil: [Cursor wait showWhile: [guide initializeIndexPage]]]]
+ 		ifNil:
+ 			[QuickGuideMorph guidePath
+ 				ifNil: [^self inform: 'There are no QuickGuides installed' translated].
+ 			Cursor wait showWhile: [self buildAndOpenHelpFlap]]!

Item was added:
+ ----- Method: SugarNavigatorBar>>toggleScreenSetting: (in category 'button actions') -----
+ toggleScreenSetting: aSymbol
+ 	"The user requested toggling of the display-mode item representing the given symbol"
+ 
+ 	| currentMode |
+ 	currentMode := self currentDisplayMode.
+ 
+ 	aSymbol = currentMode 
+ 		ifTrue:
+ 			[#(	(physical			scaledVirtual)
+ 				(scaledVirtual		physical)
+ 				(centeredVirtual	scaledVirtual)) do:
+ 					[:pair |
+ 						currentMode = pair first ifTrue: [^ self changeDisplayModeTo: pair second]]].
+ 
+ 	self changeDisplayModeTo: aSymbol!

Item was added:
+ ----- Method: SugarNavigatorBar>>toggleSupplies (in category 'button actions') -----
+ toggleSupplies
+ 
+ 	| ref f |
+ 	f _ (Flaps globalFlapTab: 'Supplies' translated).
+ 	ref _ f referent.
+ 	ref isInWorld ifTrue: [f hideFlap] ifFalse: [
+ 		f showFlap.
+ 		(owner notNil and: [owner isFlapTab]) ifTrue: [
+ 			owner edgeToAdhereTo == #top ifTrue: [
+ 				ref position: self bottomLeft.
+ 			].
+ 			owner edgeToAdhereTo == #bottom ifTrue: [
+ 				ref bottomLeft: self topLeft.
+ 			].
+ 		].
+ 	].
+ 
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>undoButtonAppearance (in category 'event handling') -----
+ undoButtonAppearance
+ 
+ 	| wording |
+ 	undoButton ifNotNil: [
+ 		ActiveWorld commandHistory undoEnabled
+ 			ifTrue: [undoButton enabled]
+ 			ifFalse: [undoButton disabled].
+ 		wording _ self undoButtonWording.
+ 		undoButton setBalloonText: wording.
+ 	].
+ 
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>wantsDroppedMorph:event: (in category 'event handling') -----
+ wantsDroppedMorph: aMorph event: evt
+ 
+ 	^ false.
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>wantsHaloForSubmorphs: (in category 'initialization') -----
+ wantsHaloForSubmorphs: aBoolean
+ 
+ 	self allMorphsDo: [:m | m setProperty: #wantsHaloFromClick toValue: aBoolean].
+ !

Item was added:
+ ----- Method: SugarNavigatorBar>>zoom (in category 'button actions') -----
+ zoom
+ 	self inFullScreenMode
+ 		ifTrue: [self fullScreenOff]
+ 		ifFalse: [self fullScreenOn]!

Item was added:
+ Notification subclass: #SugarPropertiesNotification
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sugar'!

Item was added:
+ Morph subclass: #SugarRoundedField
+ 	instanceVariableNames: 'label mask backgroundColor'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sugar'!

Item was added:
+ ----- Method: SugarRoundedField>>backgroundColor: (in category 'as yet unclassified') -----
+ backgroundColor: aColor
+ 
+ 	backgroundColor _ aColor.
+ 	mask _ self makeMask: self extent foregroundColor: color backgroundColor: backgroundColor.
+ !

Item was added:
+ ----- Method: SugarRoundedField>>drawOn: (in category 'as yet unclassified') -----
+ drawOn: aCanvas
+ 
+ 	mask ifNil: [^super drawOn: aCanvas].
+ 
+ 	aCanvas drawImage: mask at: self position.
+ !

Item was added:
+ ----- Method: SugarRoundedField>>extent: (in category 'as yet unclassified') -----
+ extent: aPoint
+ 
+ 	mask _ self makeMask: aPoint foregroundColor: color backgroundColor: backgroundColor.
+ 	"self recenterLabel."
+ 	super extent: aPoint.
+ !

Item was added:
+ ----- Method: SugarRoundedField>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 
+ 	super initialize.
+ 	self color: Color white.
+ 	backgroundColor _ (Color r: 0.258 g: 0.258 b: 0.258).
+ 	self clipSubmorphs: true.
+ 	self extent: 160 at 50.
+ !

Item was added:
+ ----- Method: SugarRoundedField>>label: (in category 'as yet unclassified') -----
+ label: aStringOrMorph
+ 
+ 	label ifNotNil: [label delete. label _ nil].
+ 	label _ aStringOrMorph.
+ 	label isString ifTrue: [
+ 		label _ StringMorph new label: label font: Preferences standardEToysFont
+ 	].
+ 	self resizeLabel.
+ !

Item was added:
+ ----- Method: SugarRoundedField>>makeMask:foregroundColor:backgroundColor: (in category 'as yet unclassified') -----
+ makeMask: extent foregroundColor: fgColor backgroundColor: bgColor
+ 
+ 	| f c diameter |
+ 	f _ Form extent: extent depth: 16.
+ 	f fillColor: bgColor.
+ 	c _ f getCanvas asBalloonCanvas.
+ 	c aaLevel: 2.
+ 	diameter _ extent x min: extent y.
+ 	c drawOval: (0 at 0 extent: diameter at diameter) color: fgColor borderWidth: 0 borderColor: Color black.
+ 	c drawOval: (((extent x - diameter)@0) extent: diameter at diameter) color: fgColor borderWidth: 0 borderColor: Color black.
+ 	c fillRectangle: (((diameter // 2)@0) extent: ((extent x - diameter)@(extent y))) fillStyle: fgColor.
+ 	c finish.
+ 	^ f.
+ !

Item was added:
+ ----- Method: SugarRoundedField>>naviHeight: (in category 'as yet unclassified') -----
+ naviHeight: aNumber
+ 
+ 	self extent: self width@(aNumber * 0.6).
+ 	self resizeLabel.!

Item was added:
+ ----- Method: SugarRoundedField>>recenterLabel (in category 'as yet unclassified') -----
+ recenterLabel
+ 
+ 	label ifNotNil: [
+ 		label center: self center.
+ 		self addMorph: label.
+ 	].
+ !

Item was added:
+ ----- Method: SugarRoundedField>>resizeLabel (in category 'as yet unclassified') -----
+ resizeLabel
+ 
+ 	| small |
+ 	label ifNotNil: [
+ 		label width: self width - 10.
+ 		small :=self height < 45.
+ 		label label: ActiveWorld project name font: (StrikeFont familyName: 'BitstreamVeraSans' size: (small ifTrue: [15] ifFalse: [24])).
+ 		label center: self center.
+ 		label left: self left + 10.
+ 		self addMorph: label.
+ 	].
+ !

Item was added:
+ ----- Method: SugarRoundedField>>wantsKeyboardFocusFor: (in category 'as yet unclassified') -----
+ wantsKeyboardFocusFor: aMorph
+ 
+ 	^ aMorph == label and: [aMorph isMemberOf: UpdatingStringMorph].
+ !

Item was added:
+ FlapTab subclass: #SugarSuppliesTab
+ 	instanceVariableNames: 'sugarNavTab'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sugar'!

Item was added:
+ ----- Method: SugarSuppliesTab>>arrangeToPopOutOnDragOver: (in category 'all') -----
+ arrangeToPopOutOnDragOver: aBoolean
+ 	aBoolean
+ 		ifTrue:
+ 			[
+ 			referent on: #mouseLeaveDragging send: #maybeHideFlapOnMouseLeaveDragging to: self.
+ 			self on: #mouseLeaveDragging send: #maybeHideFlapOnMouseLeaveDragging to: self]
+ 		ifFalse:
+ 			[self on: #mouseEnterDragging send: nil to: nil.
+ 			referent on: #mouseLeaveDragging send: nil to: nil.
+ 			self on: #mouseLeaveDragging send: nil to: nil]!

Item was added:
+ ----- Method: SugarSuppliesTab>>naviHeight: (in category 'all') -----
+ naviHeight: anInteger
+ 
+ 	submorphs ifEmpty: [^ self].
+ 	submorphs first extent: anInteger at anInteger.
+ !

Item was added:
+ ----- Method: SugarSuppliesTab>>positionObject:atEdgeOf: (in category 'all') -----
+ positionObject: anObject atEdgeOf: container
+ 
+ 	| extra |
+ 	extra _ (sugarNavTab notNil and: [referent isInWorld]) ifTrue: [sugarNavTab height] ifFalse: [0].
+ 	edgeToAdhereTo == #top ifTrue: [
+ 		^ anObject top: container innerBounds top + extra
+ 	].
+ 	edgeToAdhereTo == #bottom ifTrue: [
+ 		^ anObject bottom: container innerBounds bottom - extra
+ 	].
+ !

Item was added:
+ ----- Method: SugarSuppliesTab>>sugarNavTab:icon: (in category 'all') -----
+ sugarNavTab: anObject icon: aForm
+ 
+ 	sugarNavTab _ anObject.
+ 	aForm ifNotNil: [
+ 		self useTextualTab.
+ 		self setProperty: #priorGraphic toValue: aForm.
+ 		self useGraphicalTab.
+ 	].
+ !

Item was added:
+ ----- Method: SugarSuppliesTab>>wantsToBeTopmost (in category 'all') -----
+ wantsToBeTopmost
+ 
+ 	^ self flapShowing
+ !

Item was added:
+ Object subclass: #SugarTube
+ 	instanceVariableNames: 'id service buddy address'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Sugar'!

Item was added:
+ ----- Method: SugarTube>>address (in category 'accessing') -----
+ address
+ 	^ address!

Item was added:
+ ----- Method: SugarTube>>address: (in category 'accessing') -----
+ address: aString
+ 	address := aString!

Item was added:
+ ----- Method: SugarTube>>buddy (in category 'accessing') -----
+ buddy
+ 	buddy isString ifTrue: [
+ 		buddy := SugarLauncher current buddies at: buddy].
+ 	^ buddy!

Item was added:
+ ----- Method: SugarTube>>buddy: (in category 'accessing') -----
+ buddy: aBuddy
+ 	buddy := aBuddy!

Item was added:
+ ----- Method: SugarTube>>id (in category 'accessing') -----
+ id
+ 	^ id!

Item was added:
+ ----- Method: SugarTube>>id: (in category 'accessing') -----
+ id: anInteger
+ 	id := anInteger!

Item was added:
+ ----- Method: SugarTube>>service (in category 'accessing') -----
+ service
+ 	^ service!

Item was added:
+ ----- Method: SugarTube>>service: (in category 'accessing') -----
+ service: aString
+ 	service := aString!

Item was added:
+ ----- Method: Symbol>>isReallyString (in category '*Etoys-Squeakland-testing') -----
+ isReallyString
+ 	^ false!

Item was added:
+ Object subclass: #SyntaxAttribute
+ 	instanceVariableNames: 'color emphasis attributeList'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-System-Compiler'!
+ 
+ !SyntaxAttribute commentStamp: '<historical>' prior: 0!
+ Represents a color and possibly a style attribute to be applied to a syntactic element for pretty-printing.  The attributeList inst var is a cache.!

Item was added:
+ ----- Method: SyntaxAttribute class>>color:emphasis: (in category 'as yet unclassified') -----
+ color: aColor emphasis: anEmphasis
+ 	^ self new color: aColor; emphasis: anEmphasis; yourself!

Item was added:
+ ----- Method: SyntaxAttribute>>attributeList (in category 'accessing') -----
+ attributeList
+ 	"Answer a list of text attributes that characterize the receiver"
+ 	attributeList ifNil:
+ 		[attributeList _ OrderedCollection new: 2.
+ 		color ifNotNil: [attributeList add: (TextColor color: color)].
+ 		emphasis ifNotNil: [attributeList add: (TextEmphasis perform: emphasis)]].
+ 	^ attributeList!

Item was added:
+ ----- Method: SyntaxAttribute>>color (in category 'accessing') -----
+ color
+ 
+ 	^ color!

Item was added:
+ ----- Method: SyntaxAttribute>>color: (in category 'accessing') -----
+ color: aTextColor
+ 	color _ aTextColor.
+ 	attributeList _ nil!

Item was added:
+ ----- Method: SyntaxAttribute>>emphasis (in category 'accessing') -----
+ emphasis
+ 
+ 	^ emphasis!

Item was added:
+ ----- Method: SyntaxAttribute>>emphasis: (in category 'accessing') -----
+ emphasis: aTextEmphasis
+ 	emphasis _ aTextEmphasis.
+ 	attributeList _ nil!

Item was changed:
  ----- Method: SyntaxMorph>>attachTileForCode:nodeType: (in category 'new tiles') -----
  attachTileForCode: expression nodeType: nodeClass
  	| nn master tile |
  	"create a new tile for a part of speech, and put it into the hand"
  
  	"a few special cases"
  	expression = 'self' ifTrue: [
  		^ (((self string: expression toTilesIn: Object) 
  				findA: ReturnNode) findA: nodeClass) attachToHand].
  
  	expression = '<me by name>' ifTrue: ["Tile for the variable in References"
+ 		nn _ nodeClass knownName ifNil: [#+].
+ 		(self world referencePool at: nn asSymbol ifAbsent: [nil]) == nodeClass ifTrue: [
- 		nn := nodeClass knownName ifNil: [#+].
- 		(References at: nn asSymbol ifAbsent: [nil]) == nodeClass ifTrue: [
  			^ self attachTileForCode: nn nodeType: LiteralVariableNode].
  		"otherwise just give a tile for self"
  		^ self attachTileForCode: 'self' nodeType: VariableNode].
  
  	expression = '<assignment>' ifTrue: ["do something really special"
+ 		master _ self class new.
+ 		master addNoiseString: '  _  ' emphasis: 1.
+ 		tile _ master firstSubmorph.
- 		master := self class new.
- 		master addNoiseString: '  _   ' emphasis: TextEmphasis bold emphasisCode.
- 		tile := master firstSubmorph.
  		^ (tile parseNode: AssignmentNode new) attachToHand].	"special marker"
  		"When this is dropped on a variable, enclose it in 
  			a new assignment statement"
  
  	"general case -- a tile for a whole line of code is returned"
  	^ ((self string: expression toTilesIn: Object) 
  				findA: nodeClass) attachToHand.!

Item was added:
+ PasteUpMorph subclass: #SyntaxTestMethods
+ 	instanceVariableNames: 'letterActors wild leftMargin rightMargin switch current jumpSwitch hotIndex'
+ 	classVariableNames: 'Goal'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Tile Scriptors'!

Item was added:
+ ----- Method: SyntaxTestMethods>>altStyleTester (in category 'as yet unclassified') -----
+ altStyleTester
+ 
+ 	self doFirstThatWorks
+ 		if: [self = 1] do: [self + 1];
+ 		if: [self = 2] do: [self + 2];
+ 		if: [self = 3] do: [self + 3];
+ 		if: [self = 4] do: [self + 4];
+ 		if: [true] do: [self + 5]
+ 	
+ 	!

Item was added:
+ ----- Method: SyntaxTestMethods>>bobsplace2:after:newLine: (in category 'as yet unclassified') -----
+ bobsplace2: letter after: before newLine: isNewLine 
+ 	"Position this letter. Put its left edge where the previous letter's right edge is. Move down to the next line if isNewLine is true. Add some 	leading for condensed or expanded text."
+ 
+ 	(self doFirstThatWorks)
+ 		if: [before isNil]
+ 			do: [self selfWrittenAsIll march: letter to: leftMargin topRight];
+ 		if: [isNewLine]
+ 			do: 
+ 				[self selfWrittenAsIll march: letter
+ 					to: leftMargin right @ (before bottom + 1)];
+ 		if: [true] do: [self selfWrittenAsIll march: letter to: before topRight]!

Item was added:
+ ----- Method: SyntaxTestMethods>>bobsplace:after:newLine: (in category 'as yet unclassified') -----
+ bobsplace: letter after: before newLine: isNewLine 
+ 	"Position this letter. Put its left edge where the previous letter's right 	edge is. Move down to the next line if isNewLine is true. Add some 	leading for condensed or expanded text."
+ 
+ 	before isNil
+ 		ifTrue: [self selfWrittenAsIll march: letter to: leftMargin topRight]
+ 		ifFalse: 
+ 			[isNewLine 
+ 				ifTrue: 
+ 					[self selfWrittenAsIll march: letter
+ 						to: leftMargin right @ (before bottom + 1)]
+ 				ifFalse: [self selfWrittenAsIll march: letter to: before topRight]].
+ 	^self!

Item was added:
+ ----- Method: SyntaxTestMethods>>doAndCollect (in category 'as yet unclassified') -----
+ doAndCollect
+ 
+ 	self do: [ :j | j isEmpty ifFalse: [j size]].
+ 	self collect: [ :each | each asString withBlanksTrimmed].
+ 	!

Item was added:
+ ----- Method: SyntaxTestMethods>>makeRandomString (in category 'as yet unclassified') -----
+ makeRandomString
+ 
+ 	| newString foo |
+ 
+ 	newString _ String new: Goal contents size.
+ 	foo _ Goal contents size.
+ 	^newString collect: [ :oldLetter | 'abcdefghijklmnopqrstuvwxyz' atRandom]
+ !

Item was added:
+ ----- Method: SyntaxTestMethods>>repeatExample (in category 'as yet unclassified') -----
+ repeatExample
+ 
+ 	self
+ 		repeatFor: (1 to: 50)
+ 		doing: [ :i | i + 3]!

Item was added:
+ ----- Method: SyntaxTestMethods>>st76LeftArrowTest: (in category 'as yet unclassified') -----
+ st76LeftArrowTest: foo
+ 
+ 	foo contentsGetz: foo contents asUppercase
+ 	
+ 	!

Item was added:
+ ----- Method: SyntaxTestMethods>>wordyTestMethod (in category 'as yet unclassified') -----
+ wordyTestMethod
+ 
+ 	self selfWrittenAsMe = 1 ifTrue: [
+ 		self selfWrittenAsMy size.
+ 		self selfWrittenAsIll stop.
+ 		self selfWrittenAsIm large.
+ 		self selfWrittenAsThis helps.
+ 	].
+ !

Item was added:
+ ----- Method: SystemDictionary>>abandonTempNames (in category '*Etoys-Squeakland-shrinking') -----
+ abandonTempNames
+ 	"Replaces every method by a copy with no source pointer or
+ 	encoded temp names."
+ 	"Smalltalk abandonTempNames"
+ 	| oldMethods newMethods n m |
+ 	self forgetDoIts; garbageCollect.
+ 	oldMethods := OrderedCollection new.
+ 	newMethods := OrderedCollection new.
+ 	n := 0.
+ 	'Removing temp names to save space...'
+ 		displayProgressAt: Sensor cursorPoint
+ 		from: 0
+ 		to: CompiledMethod instanceCount
+ 		during: [:bar | self systemNavigation
+ 				allBehaviorsDo: [:cl | cl selectors
+ 						do: [:sel | 
+ 							bar value: (n := n + 1).
+ 							m := cl compiledMethodAt: sel.
+ 							oldMethods addLast: m.
+ 							newMethods
+ 								addLast: (m copyWithTrailerBytes: #(0 ))]]].
+ 	oldMethods asArray elementsExchangeIdentityWith: newMethods asArray.
+ 	SmalltalkImage current closeSourceFiles.
+ 	self flag: #shouldUseAEnsureBlockToBeSureThatTheFileIsClosed.
+ 	"sd: 17 April 2003"
+ 	Preferences disable: #warnIfNoChangesFile.
+ 	Preferences disable: #warnIfNoSourcesFile!

Item was added:
+ ----- Method: SystemDictionary>>bytesLeft (in category '*Etoys-Squeakland-memory space') -----
+ bytesLeft
+ 	"Answer the number of bytes of space available. Does a full garbage collection."
+ 
+ 	^ self garbageCollect
+ !

Item was added:
+ ----- Method: SystemDictionary>>changesName (in category '*Etoys-Squeakland-deprecated') -----
+ changesName
+ 	"Answer the name for the changes file corresponding to the image file name."
+ 	"Smalltalk changesName"
+ 
+ 	self deprecated: 'Use SmalltalkImage current changesName'.
+ 
+ 	^SmalltalkImage current changesName!

Item was added:
+ ----- Method: SystemDictionary>>cleanOutUndeclared (in category '*Etoys-Squeakland-housekeeping') -----
+ cleanOutUndeclared 
+ 	Undeclared removeUnreferencedKeys!

Item was added:
+ ----- Method: SystemDictionary>>compressSources (in category '*Etoys-Squeakland-housekeeping') -----
+ compressSources	
+ 	"Copy all the source file to a compressed file. Usually preceded by Smalltalk condenseSources."
+ 	"The new file will be created in the default directory, and the code in openSources
+ 	will try to open it if it is there, otherwise it will look for normal sources."
+ 	"Smalltalk compressSources"
+ 
+ 	| f cfName cf |
+ 	f := SourceFiles first readOnlyCopy binary.	"binary to preserve utf8 encoding"
+ 	(f localName endsWith: 'sources')
+ 		ifTrue: [cfName := (f localName allButLast: 7) , 'stc']
+ 		ifFalse: [self error: 'Hey, I thought the sources name ended with ''.sources''.'].
+ 	cf := (CompressedSourceStream on: (FileStream newFileNamed: cfName))
+ 				segmentSize: 65536 maxSize: f size.
+ 
+ 	"Copy the sources"
+ 'Compressing Sources File...'
+ 	displayProgressAt: Sensor cursorPoint
+ 	from: 0 to: f size
+ 	during:
+ 		[:bar | f position: 0.
+ 		[f atEnd] whileFalse:
+ 			[cf nextPutAll: (f next: 65536).
+ 			bar value: f position]].
+ 	cf close.
+ 	self setMacFileInfoOn: cfName.
+ 	self inform: 'You now have a compressed sources file!!
+ Squeak will use it the next time you start.'!

Item was added:
+ ----- Method: SystemDictionary>>condenseSources (in category '*Etoys-Squeakland-housekeeping') -----
+ condenseSources
+ 	"Move all the changes onto a compacted sources file."
+ 	"Smalltalk condenseSources"
+ 
+ 	| newVersionString |
+ 	newVersionString _ FillInTheBlank request: 'Please designate the version
+ for the new source code file...' initialAnswer: SmalltalkImage current sourceFileVersionString.
+ 	^ self condenseSourcesForVersion: newVersionString.
+ !

Item was added:
+ ----- Method: SystemDictionary>>condenseSourcesForVersion: (in category '*Etoys-Squeakland-housekeeping') -----
+ condenseSourcesForVersion: aString
+ 	"Move all the changes onto a compacted sources file."
+ 	"Smalltalk condenseSources"
+ 
+ 	| f classCount dir newVersionString |
+ 	Utilities fixUpProblemsWithAllCategory.
+ 	"The above removes any concrete, spurious '-- all --' categories, which mess up the process."
+ 	dir _ FileDirectory default.
+ 	newVersionString _ aString.
+ 	newVersionString ifNil: [^ self].
+ 	newVersionString = SmalltalkImage current  sourceFileVersionString ifTrue:
+ 		[^ self error: 'The new source file must not be the same as the old.'].
+ 	SmalltalkImage current sourceFileVersionString:  newVersionString.
+ 
+ 	"Write all sources with fileIndex 1"
+ 	f _ FileStream newFileNamed: SmalltalkImage current sourcesName.
+ 	f converter: UTF8TextConverter new.  "This is needed only when converting from SqueakV3.sources."
+ 	f header; timeStamp.
+ 'Condensing Sources File...'
+ 	displayProgressAt: Sensor cursorPoint
+ 	from: 0 to: Smalltalk classNames size
+ 	during:
+ 		[:bar | classCount _ 0.
+ 		Smalltalk allClassesDo:
+ 			[:class | bar value: (classCount _ classCount + 1).
+ 			class fileOutOn: f moveSource: true toFile: 1]].
+ 	f trailer; close.
+ 
+ 	"Make a new empty changes file"
+ 	SmalltalkImage current closeSourceFiles.
+ 	dir rename: SmalltalkImage current changesName
+ 		toBe: SmalltalkImage current changesName , '.old'.
+ 	(FileStream newFileNamed: SmalltalkImage current changesName)
+ 		header; timeStamp; close.
+ 	SmalltalkImage current lastQuitLogPosition: 0.
+ 
+ 	self setMacFileInfoOn: SmalltalkImage current changesName.
+ 	self setMacFileInfoOn: SmalltalkImage current sourcesName.
+ 	SmalltalkImage current openSourceFiles.
+ 	self inform: 'Source files have been rewritten!!
+ Check that all is well,
+ and then save/quit.'!

Item was added:
+ ----- Method: SystemDictionary>>copyright (in category '*Etoys-Squeakland-sources, change log') -----
+ copyright
+ 	"The Smalltalk copyright."
+ 
+ 	^'Copyright (c) 1996 Apple Computer, Inc. All Rights Reserved.
+ Copyright (c) 1996-2009 Viewpoints Research Institute, and Contributors;
+ Copyright (c) 2010-2012 Squeak Community Contributors'!

Item was added:
+ ----- Method: SystemDictionary>>createStackOverflow (in category '*Etoys-Squeakland-memory space') -----
+ createStackOverflow
+ 	"For testing the low space handler..."
+ 	"Smalltalk installLowSpaceWatcher; createStackOverflow"
+ 
+ 	self createStackOverflow.  "infinite recursion"!

Item was added:
+ ----- Method: SystemDictionary>>currentChangeSetString (in category '*Etoys-Squeakland-sources, change log') -----
+ currentChangeSetString
+ 	"Smalltalk currentChangeSetString"
+ 	^ 'Current Change Set: ' translated, ChangeSet current name!

Item was added:
+ ----- Method: SystemDictionary>>exitToDebugger (in category '*Etoys-Squeakland-miscellaneous') -----
+ exitToDebugger
+ 	"Primitive. Enter the machine language debugger, if one exists. Essential.
+ 	See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 114>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: SystemDictionary>>garbageCollectMost (in category '*Etoys-Squeakland-memory space') -----
+ garbageCollectMost
+ 	"Primitive. Reclaims recently created garbage (which is usually most of it) fairly quickly and answers the number of bytes of available space."
+ 
+ 	<primitive: 131>
+ 	^ self primBytesLeft!

Item was added:
+ ----- Method: SystemDictionary>>globals (in category '*Etoys-Squeakland-accessing') -----
+ globals
+ 	^self!

Item was added:
+ ----- Method: SystemDictionary>>installLowSpaceWatcher (in category '*Etoys-Squeakland-memory space') -----
+ installLowSpaceWatcher
+ 	"Start a process to watch for low-space conditions."
+ 	"Smalltalk installLowSpaceWatcher"
+ 
+ 	self primSignalAtBytesLeft: 0.  "disable low-space interrupts"
+ 	LowSpaceProcess == nil ifFalse: [LowSpaceProcess terminate].
+ 	LowSpaceProcess _ [self lowSpaceWatcher] newProcess.
+ 	LowSpaceProcess priority: Processor lowIOPriority.
+ 	LowSpaceProcess resume.
+ 
+ !

Item was added:
+ ----- Method: SystemDictionary>>lastQuitLogPosition (in category '*Etoys-Squeakland-toDeprecate') -----
+ lastQuitLogPosition
+ 
+ 	self deprecated: 'Use SmalltalkImage current lastQuitLogPosition'.
+ 	^ SmalltalkImage current lastQuitLogPosition.
+ !

Item was added:
+ ----- Method: SystemDictionary>>logError:inContext:to: (in category '*Etoys-Squeakland-miscellaneous') -----
+ logError: errMsg inContext: aContext to: aFilename
+ 	"Log the error message and a stack trace to the given file."
+ 
+ 	| ff |
+ 	[Preferences logDebuggerStackToConsole
+ 		ifTrue: [FileStream stderr ifNotNilDo: [:stderr |
+ 			stderr nextPutAll: '=========== ';
+ 				nextPutAll: aFilename;
+ 				nextPutAll: ' START =========='; cr;
+ 				nextPutAll: errMsg; cr;
+ 				nextPutAll: (String streamContents: [:strm |
+ 					aContext errorReportOn: strm]);
+ 				nextPutAll: '=========== ';
+ 				nextPutAll: aFilename;
+ 				nextPutAll: ' END  =========='; cr]]] ifError: ["ignore"].
+ 
+ 	FileDirectory default deleteFileNamed: aFilename ifAbsent: [].
+ 	(ff _ FileStream fileNamed: aFilename) ifNil: [^ self "avoid recursive errors"].
+ 
+   	ff nextPutAll: errMsg; cr.
+ 	aContext errorReportOn: ff.
+ 	ff close.
+ !

Item was added:
+ ----- Method: SystemDictionary>>lowSpaceWatcher (in category '*Etoys-Squeakland-memory space') -----
+ lowSpaceWatcher
+ 	"Wait until the low space semaphore is signalled, then take appropriate actions."
+ 
+ 	| free preemptedProcess |
+ 	self garbageCollectMost <= self lowSpaceThreshold
+ 		ifTrue: [self garbageCollect <= self lowSpaceThreshold
+ 				ifTrue: ["free space must be above threshold before
+ 					starting low space watcher"
+ 					^ Beeper beep]].
+ 
+ 	Smalltalk specialObjectsArray at: 23 put: nil.  "process causing low space will be saved here"
+ 	LowSpaceSemaphore := Semaphore new.
+ 	self primLowSpaceSemaphore: LowSpaceSemaphore.
+ 	self primSignalAtBytesLeft: self lowSpaceThreshold.  "enable low space interrupts"
+ 
+ 	LowSpaceSemaphore wait.  "wait for a low space condition..."
+ 
+ 	self primSignalAtBytesLeft: 0.  "disable low space interrupts"
+ 	self primLowSpaceSemaphore: nil.
+ 	LowSpaceProcess := nil.
+ 
+ 	"The process that was active at the time of the low space interrupt."
+ 	preemptedProcess := Smalltalk specialObjectsArray at: 23.
+ 	Smalltalk specialObjectsArray at: 23 put: nil.
+ 
+ 	"Note: user now unprotected until the low space watcher is re-installed"
+ 
+ 	self memoryHogs isEmpty
+ 		ifFalse: [free := self bytesLeft.
+ 			self memoryHogs
+ 				do: [ :hog | hog freeSomeSpace ].
+ 			self bytesLeft > free
+ 				ifTrue: [ ^ self installLowSpaceWatcher ]].
+ 	self isMorphic
+ 		ifTrue: [CurrentProjectRefactoring
+ 				currentInterruptName: 'Space is low'
+ 				preemptedProcess: preemptedProcess]
+ 		ifFalse: [ScheduledControllers
+ 				interruptName: 'Space is low'
+ 				preemptedProcess: preemptedProcess]
+ !

Item was added:
+ ----- Method: SystemDictionary>>makeSqueaklandReleasePhaseCleanup (in category '*Etoys-Squeakland-squeakland') -----
+ makeSqueaklandReleasePhaseCleanup
+ 	"Smalltalk makeSqueaklandReleasePhaseCleanup"
+ 
+ 	Browser initialize.
+ 	ChangeSorter removeChangeSetsNamedSuchThat:
+ 		[:cs| cs name ~= ChangeSet current name].
+ 	ChangeSet current clear.
+ 	ChangeSet current name: 'Unnamed' translated , '1'.
+ 	Smalltalk garbageCollect.
+ 	"Reinitialize DataStream; it may hold on to some zapped entitities"
+ 	DataStream initialize.
+ 	"Remove existing player references"
+ 	References keys do:[:k| References removeKey: k].
+ 
+ 	Smalltalk garbageCollect.
+ 	ScheduledControllers _ nil.
+ 	Behavior flushObsoleteSubclasses.
+ 	Smalltalk garbageCollect; garbageCollect.
+ 	Smalltalk obsoleteBehaviors isEmpty ifFalse:[self error:'Still have obsolete behaviors'].
+ 
+ 	"Reinitialize DataStream; it may hold on to some zapped entitities"
+ 	DataStream initialize.
+ 	Smalltalk fixObsoleteReferences.
+ 	Smalltalk abandonTempNames.
+ 	Smalltalk zapAllOtherProjects.
+ 	Smalltalk forgetDoIts.
+ 	Smalltalk flushClassNameCache.
+ 	3 timesRepeat: [
+ 		Smalltalk garbageCollect.
+ 		Symbol compactSymbolTable.
+ 	].
+ !

Item was added:
+ ----- Method: SystemDictionary>>makeSqueaklandReleasePhaseFinalSettings (in category '*Etoys-Squeakland-squeakland') -----
+ makeSqueaklandReleasePhaseFinalSettings
+ 	"Smalltalk makeSqueaklandReleasePhaseFinalSettings"
+ 
+ 	| serverName serverURL serverDir updateServer highestUpdate newVersion |
+ 
+ 	ProjectLauncher splashMorph: ((FileDirectory default directoryNamed: 'scripts' )readOnlyFileNamed: 'SqueaklandSplash.morph') fileInObjectAndCode.
+ 
+ 	"Dump all morphs so we don't hold onto anything"
+ 	World submorphsDo:[:m| m delete].
+ 
+ 	#(
+ 		(honorDesktopCmdKeys false)
+ 		(warnIfNoChangesFile false)
+ 		(warnIfNoSourcesFile false)
+ 		(showDirectionForSketches true)
+ 		(menuColorFromWorld false)
+ 		(unlimitedPaintArea true)
+ 		(useGlobalFlaps false)
+ 		(mvcProjectsAllowed false)
+ 		(projectViewsInWindows false)
+ 		(automaticKeyGeneration true)
+ 		(securityChecksEnabled true)
+ 		(showSecurityStatus false)
+ 		(startInUntrustedDirectory true)
+ 		(warnAboutInsecureContent false)
+ 		(promptForUpdateServer false)
+ 		(fastDragWindowForMorphic false)
+ 
+ 		(externalServerDefsOnly true)
+ 		(expandedFormat false)
+ 		(allowCelesteTell false)
+ 		(eToyFriendly true)
+ 		(eToyLoginEnabled true)
+ 		(magicHalos true)
+ 		(mouseOverHalos true)
+ 		(biggerHandles false)
+ 		(selectiveHalos true)
+ 		(includeSoundControlInNavigator true)
+ 		(readDocumentAtStartup true)
+ 		(preserveTrash true)
+ 		(slideDismissalsToTrash true)
+ 
+ 	) do:[:spec|
+ 		Preferences setPreference: spec first toValue: spec last].
+ 	"Workaround for bug"
+ 	Preferences enable: #readDocumentAtStartup.
+ 
+ 	World color: (Color r: 0.9 g: 0.9 b: 1.0).
+ 
+ 	"Clear all server entries"
+ 	ServerDirectory serverNames do: [:each | ServerDirectory removeServerNamed: each].
+ 	SystemVersion current resetHighestUpdate.
+ 
+ 	"Add the squeakalpha update stream"
+ 	serverName _ 'Squeakalpha'.
+ 	serverURL _ 'squeakalpha.org'.
+ 	serverDir _ serverURL , '/'.
+ 
+ 	updateServer _ ServerDirectory new.
+ 	updateServer
+ 		server: serverURL;
+ 		directory: 'updates/';
+ 		altUrl: serverDir;
+ 		user: 'sqland';
+ 		password: nil.
+ 	Utilities updateUrlLists addFirst: {serverName. {serverDir. }.}.
+ 
+ 	"Add the squeakland update stream"
+ 	serverName _ 'Squeakland'.
+ 	serverURL _ 'squeakland.org'.
+ 	serverDir _ serverURL , '/'.
+ 
+ 	updateServer _ ServerDirectory new.
+ 	updateServer
+ 		server: serverURL;
+ 		directory: 'public_html/updates/';
+ 		altUrl: serverDir.
+ 	Utilities updateUrlLists addFirst: {serverName. {serverDir. }.}.
+ 
+ 	highestUpdate _ SystemVersion current highestUpdate.
+ 	(self confirm: 'Reset highest update (' , highestUpdate printString , ')?')
+ 		ifTrue: [SystemVersion current highestUpdate: 0].
+ 
+ 	newVersion _ FillInTheBlank request: 'New version designation:' initialAnswer: 'Squeakland 3.8.' , highestUpdate printString. 
+ 	SystemVersion newVersion: newVersion.
+ 	(self confirm: self version , '
+ Is this the correct version designation?
+ If not, choose no, and fix it.') ifFalse: [^ self].
+ !

Item was added:
+ ----- Method: SystemDictionary>>okayToProceedEvenIfSpaceIsLow (in category '*Etoys-Squeakland-memory space') -----
+ okayToProceedEvenIfSpaceIsLow
+ 	"Return true if either there is enough memory to do so safely or if the user gives permission after being given fair warning."
+ 
+ 	self garbageCollectMost > self lowSpaceThreshold ifTrue: [^ true].  "quick"
+ 	self garbageCollect > self lowSpaceThreshold ifTrue: [^ true].  "work harder"
+ 
+ 	^ self confirm:
+ 'WARNING: There is not enough space to start the low space watcher.
+ If you proceed, you will not be warned again, and the system may
+ run out of memory and crash. If you do proceed, you can start the
+ low space notifier when more space becomes available simply by
+ opening and then closing a debugger (e.g., by hitting Cmd-period.)
+ Do you want to proceed?'
+ !

Item was added:
+ ----- Method: SystemDictionary>>primBytesLeft (in category '*Etoys-Squeakland-memory space') -----
+ primBytesLeft
+ 	"Primitive. Answer the number of bytes available for new object data.
+ 	Not accurate unless preceded by
+ 		Smalltalk garbageCollectMost (for reasonable accuracy), or
+ 		Smalltalk garbageCollect (for real accuracy).
+ 	See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 112>
+ 	^ 0!

Item was added:
+ ----- Method: SystemDictionary>>primLowSpaceSemaphore: (in category '*Etoys-Squeakland-memory space') -----
+ primLowSpaceSemaphore: aSemaphore
+ 	"Primitive. Register the given Semaphore to be signalled when the
+ 	number of free bytes drops below some threshold. Disable low-space
+ 	interrupts if the argument is nil."
+ 
+ 	<primitive: 124>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: SystemDictionary>>primSignalAtBytesLeft: (in category '*Etoys-Squeakland-memory space') -----
+ primSignalAtBytesLeft: numBytes
+ 	"Tell the interpreter the low-space threshold in bytes. When the free
+ 	space falls below this threshold, the interpreter will signal the low-space
+ 	semaphore, if one has been registered.  Disable low-space interrupts if the
+ 	argument is zero.  Fail if numBytes is not an Integer."
+ 
+ 	<primitive: 125>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: SystemDictionary>>quitPrimitive (in category '*Etoys-Squeakland-snapshot and quit') -----
+ quitPrimitive
+ 	"Primitive. Exit to another operating system on the host machine, if one
+ 	exists. All state changes in the object space since the last snapshot are lost.
+ 	Essential. See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 113>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: SystemDictionary>>reconstructChanges (in category '*Etoys-Squeakland-housekeeping') -----
+ reconstructChanges	
+ 	"Move all the changes and its histories onto another sources file."
+ 	"Smalltalk reconstructChanges"
+ 
+ 	| f oldChanges classCount |
+ 	f _ FileStream fileNamed: 'ST80.temp'.
+ 	f header; timeStamp.
+ 'Condensing Changes File...'
+ 	displayProgressAt: Sensor cursorPoint
+ 	from: 0 to: Smalltalk classNames size
+ 	during:
+ 		[:bar | classCount _ 0.
+ 		Smalltalk allClassesDo:
+ 			[:class | bar value: (classCount _ classCount + 1).
+ 			class moveChangesWithVersionsTo: f.
+ 			class putClassCommentToCondensedChangesFile: f.
+ 			class class moveChangesWithVersionsTo: f]].
+ 	SmalltalkImage current lastQuitLogPosition: f position.
+ 	f trailer; close.
+ 	oldChanges _ SourceFiles at: 2.
+ 	oldChanges close.
+ 	FileDirectory default 
+ 		deleteFileNamed: oldChanges name , '.old';
+ 		rename: oldChanges name toBe: oldChanges name , '.old';
+ 		rename: f name toBe: oldChanges name.
+ 	self setMacFileInfoOn: oldChanges name.
+ 	SourceFiles at: 2
+ 			put: (FileStream oldFileNamed: oldChanges name)!

Item was added:
+ ----- Method: SystemDictionary>>recreateSpecialObjectsArray (in category '*Etoys-Squeakland-special objects') -----
+ recreateSpecialObjectsArray
+ 	"Smalltalk recreateSpecialObjectsArray"
+ 	"The Special Objects Array is an array of object pointers used
+ 	by the
+ 	Squeak virtual machine. Its contents are critical and
+ 	unchecked, so don't even think of playing here unless you
+ 	know what you are doing."
+ 	| newArray |
+ 	newArray := Array new: 50.
+ 	"Nil false and true get used throughout the interpreter"
+ 	newArray at: 1 put: nil.
+ 	newArray at: 2 put: false.
+ 	newArray at: 3 put: true.
+ 	"This association holds the active process (a ProcessScheduler)"
+ 	newArray at: 4 put: (self associationAt: #Processor).
+ 	"Numerous classes below used for type checking and instantiation"
+ 	newArray at: 5 put: Bitmap.
+ 	newArray at: 6 put: SmallInteger.
+ 	newArray at: 7 put: ByteString.
+ 	newArray at: 8 put: Array.
+ 	newArray at: 9 put: Smalltalk.
+ 	newArray at: 10 put: Float.
+ 	newArray at: 11 put: MethodContext.
+ 	newArray at: 12 put: BlockContext.
+ 	newArray at: 13 put: Point.
+ 	newArray at: 14 put: LargePositiveInteger.
+ 	newArray at: 15 put: ((Display respondsTo: #actualDisplay)
+ 	    ifTrue: [Display actualDisplay] ifFalse: [Display]).
+ 	newArray at: 16 put: Message.
+ 	newArray at: 17 put: CompiledMethod.
+ 	newArray at: 18 put: (self specialObjectsArray at: 18).
+ 	"(low space Semaphore)"
+ 	newArray at: 19 put: Semaphore.
+ 	newArray at: 20 put: Character.
+ 	newArray at: 21 put: #doesNotUnderstand:.
+ 	newArray at: 22 put: #cannotReturn:.
+ 	newArray at: 23 put: nil.
+ 	"An array of the 32 selectors that are compiled as special bytecodes,
+ 	 paired alternately with the number of arguments each takes."
+ 	newArray at: 24 put: #(	#+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1
+ 							#* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1
+ 							#at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0
+ 							#blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0 ).
+ 	"An array of the 255 Characters in ascii order."
+ 	newArray at: 25 put: ((0 to: 255) collect: [:ascii | Character value: ascii]).
+ 	newArray at: 26 put: #mustBeBoolean.
+ 	newArray at: 27 put: ByteArray.
+ 	newArray at: 28 put: Process.
+ 	"An array of up to 31 classes whose instances will have compact headers"
+ 	newArray at: 29 put: self compactClassesArray.
+ 	newArray at: 30 put: (self specialObjectsArray at: 30).
+ 	"(delay Semaphore)"
+ 	newArray at: 31 put: (self specialObjectsArray at: 31).
+ 	"(user interrupt Semaphore)"
+ 	"Prototype instances that can be copied for fast initialization"
+ 	newArray at: 32 put: (Float new: 2).
+ 	newArray at: 33 put: (LargePositiveInteger new: 4).
+ 	newArray at: 34 put: Point new.
+ 	newArray at: 35 put: #cannotInterpret:.
+ 	"Note: This must be fixed once we start using context prototypes (yeah, right)"
+ 	"(MethodContext new: CompiledMethod fullFrameSize)."
+ 	newArray at: 36 put: (self specialObjectsArray at: 36). "Is the prototype MethodContext (unused by the VM)"
+ 	newArray at: 37 put: nil.
+ 	"(BlockContext new: CompiledMethod fullFrameSize)."
+ 	newArray at: 38 put: (self specialObjectsArray at: 38). "Is the prototype BlockContext (unused by the VM)"
+ 	newArray at: 39 put: (self specialObjectsArray at: 39).	"preserve external semaphores"
+ 	"array of objects referred to by external code"
+ 	newArray at: 40 put: PseudoContext.
+ 	newArray at: 41 put: TranslatedMethod.
+ 	"finalization Semaphore"
+ 	newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]).
+ 	newArray at: 43 put: LargeNegativeInteger.
+ 	"External objects for callout.
+ 	 Note: Written so that one can actually completely remove the FFI."
+ 	newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
+ 	newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
+ 	newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
+ 	newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
+ 	newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
+ 	newArray at: 49 put: #aboutToReturn:through:.
+ 	newArray at: 50 put: #run:with:in:.
+ 	"Now replace the interpreter's reference in one atomic operation"
+ 	self specialObjectsArray become: newArray!

Item was added:
+ ----- Method: SystemDictionary>>reformatChangesToUTF8 (in category '*Etoys-Squeakland-housekeeping') -----
+ reformatChangesToUTF8
+ 	"Smalltalk reformatChangesToUTF8"
+ 
+ 	| f oldChanges classCount |
+ 	f _ FileStream fileNamed: 'ST80.temp'.
+ 	f converter: (UTF8TextConverter new).
+ 	f header; timeStamp.
+ 'Condensing Changes File...'
+ 	displayProgressAt: Sensor cursorPoint
+ 	from: 0 to: Smalltalk classNames size
+ 	during:
+ 		[:bar | classCount _ 0.
+ 		Smalltalk allClassesDo:
+ 			[:class | bar value: (classCount _ classCount + 1).
+ 			class moveChangesTo: f.
+ 			class putClassCommentToCondensedChangesFile: f.
+ 			class class moveChangesTo: f]].
+ 	SmalltalkImage current lastQuitLogPosition: f position.
+ 	f trailer; close.
+ 	oldChanges _ SourceFiles at: 2.
+ 	oldChanges close.
+ 	FileDirectory default 
+ 		deleteFileNamed: oldChanges name , '.old';
+ 		rename: oldChanges name toBe: oldChanges name , '.old';
+ 		rename: f name toBe: oldChanges name.
+ 	self setMacFileInfoOn: oldChanges name.
+ 	SourceFiles at: 2
+ 			put: (FileStream oldFileNamed: oldChanges name).
+ 	MultiByteFileStream codeConverterClass: UTF8TextConverter.
+ 	(SourceFiles at: 2) converter: (UTF8TextConverter new).
+ !

Item was added:
+ ----- Method: SystemDictionary>>signalLowSpace (in category '*Etoys-Squeakland-memory space') -----
+ signalLowSpace
+ 	"Signal the low-space semaphore to alert the user that space is running low."
+ 
+ 	LowSpaceSemaphore signal.!

Item was added:
+ ----- Method: SystemDictionary>>specialNargsAt: (in category '*Etoys-Squeakland-special objects') -----
+ specialNargsAt: anInteger 
+ 	"Answer the number of arguments for the special selector at: anInteger."
+ 
+ 	^ (self specialObjectsArray at: 24) at: anInteger * 2!

Item was added:
+ ----- Method: SystemDictionary>>specialObjectsArray (in category '*Etoys-Squeakland-special objects') -----
+ specialObjectsArray  "Smalltalk specialObjectsArray at: 1"
+ 	<primitive: 129>
+ 	^ self primitiveFailed!

Item was added:
+ ----- Method: SystemDictionary>>specialSelectorAt: (in category '*Etoys-Squeakland-special objects') -----
+ specialSelectorAt: anInteger 
+ 	"Answer the special message selector from the interleaved specialSelectors array."
+ 
+ 	^ (self specialObjectsArray at: 24) at: anInteger * 2 - 1!

Item was added:
+ ----- Method: SystemDictionary>>specialSelectorSize (in category '*Etoys-Squeakland-special objects') -----
+ specialSelectorSize
+ 	"Answer the number of special selectors in the system."
+ 
+ 	^ (self specialObjectsArray at: 24) size // 2!

Item was added:
+ ----- Method: SystemDictionary>>specialSelectors (in category '*Etoys-Squeakland-special objects') -----
+ specialSelectors
+ 	"Used by SystemTracer only."
+ 
+ 	^SpecialSelectors!

Item was added:
+ ----- Method: SystemNavigation>>allCompiledMethodDo: (in category '*Etoys-Squeakland-query') -----
+ allCompiledMethodDo: aBlock 
+ 	Cursor execute
+ 		showWhile: [self
+ 				allBehaviorsDo: [:cl | cl
+ 						selectorsDo: [:sel | aBlock
+ 								value: (cl compiledMethodAt: sel)]]]!

Item was added:
+ ----- Method: SystemProgressMorph class>>example2 (in category '*Etoys-Squeakland-examples') -----
+ example2
+ 	"SystemProgressMorph example2"
+ 	'Progress' 
+ 		displayProgressAt: Display center
+ 		from: 0 to: 10
+ 		during: [:bar | 0 to: 10 do: [:i | bar value: i.
+ 			'Progress2' displayProgressAt: Display center
+ 				from: 0 to: 100
+ 				during: [:baz | 0 to: 100 do: [:j | baz value: j.
+ 					(Delay forMilliseconds: 2) wait]]]].
+ !

Item was added:
+ ----- Method: SystemProgressMorph>>label:min:max: (in category '*Etoys-Squeakland-private') -----
+ label: shortDescription min: minValue max: maxValue
+ 	| slot range newBarSize barSize lastRefresh index |
+ 	((range _ maxValue - minValue) <= 0 or: [(slot _ self nextSlotFor: shortDescription) = 0])
+ 		ifTrue: [^[:barVal| 0 ]].
+ 	self openInWorld.
+ 	activeSlots <= 1
+ 		ifTrue: [self align: self fullBounds center with: Display boundingBox center].
+ 	barSize _ -1. "Enforces a inital draw of the morph"
+ 	lastRefresh _ 0.
+ 	index _ Preferences unifyNestedProgressBars ifFalse: [slot] ifTrue: [1].
+ 	^[:barVal | 
+ 		(barVal between: minValue and: maxValue) ifTrue: [
+ 			newBarSize _ (barVal - minValue / range * BarWidth) truncated.
+ 			newBarSize > barSize ifTrue: [
+ 				barSize _ newBarSize.
+ 				(bars at: index) barSize: barSize.
+ 				Time primMillisecondClock - lastRefresh > 25 ifTrue: [
+ 					self currentWorld displayWorld.
+ 					lastRefresh _ Time primMillisecondClock]]].
+ 		slot]
+ !

Item was added:
+ ----- Method: SystemProgressMorph>>nextSlotUnifiedFor: (in category '*Etoys-Squeakland-private') -----
+ nextSlotUnifiedFor: shortDescription
+ 	| bar label index |
+ 	lock critical: [
+ 		activeSlots _ activeSlots + 1.
+ 		index _ 1.
+ 		bar _ (bars at: index).
+ 		bar ifNil: [
+ 			bar _ bars at: 1 put: (SystemProgressBarMorph new extent: BarWidth at BarHeight).
+ 			label _ labels at: 1 put: (StringMorph contents: shortDescription font: font).
+ 			self
+ 				addMorphBack: label;
+ 				addMorphBack: bar.
+ 		].
+ 		bar owner ifNil: [
+ 			bar _ bars at: index.
+ 			label _ labels at: index.
+ 			self
+ 				addMorphBack: (label contents: shortDescription);
+ 				addMorphBack: (bar barSize: 0).
+ 		]].
+ 	^ activeSlots.
+ !

Item was added:
+ ----- Method: SystemQueryPhrase>>addCommandFeedback: (in category '*Etoys-Squeakland-hilighting') -----
+ addCommandFeedback: evt
+ 	"Add screen feedback showing what would be torn off in a drag.  Overridden vacuously here to avoid a crash when super code is applied to a SystemQueryPhrase."!

Item was added:
+ ----- Method: SystemQueryPhrase>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') -----
+ parseNodeWith: encoder
+ 
+ 	^ submorphs first parseNodeWith: encoder!

Item was added:
+ ----- Method: SystemVersion>>baseName (in category '*Etoys-Squeakland-accessing') -----
+ baseName
+ 	"version sans number"
+ 	| p |
+ 	p := version findFirst: [:c | c isLetter not].
+ 	^p = 0
+ 		ifTrue: [version]
+ 		ifFalse: [version first: p - 1]!

Item was added:
+ ----- Method: SystemVersion>>repositoryDate (in category '*Etoys-Squeakland-accessing') -----
+ repositoryDate
+ 	^repositoryDate ifNil: [self date]!

Item was added:
+ ----- Method: SystemVersion>>repositoryDate: (in category '*Etoys-Squeakland-accessing') -----
+ repositoryDate: aDate
+ 	repositoryDate := aDate
+ !

Item was added:
+ ----- Method: SystemVersion>>repositoryString (in category '*Etoys-Squeakland-accessing') -----
+ repositoryString
+ 	^self repositoryVersion > 0
+ 		ifFalse: ['']
+ 		ifTrue: [
+ 			'repo v', self repositoryVersion asString,
+ 			' of ', self repositoryDate asString]!

Item was added:
+ ----- Method: SystemVersion>>repositoryVersion (in category '*Etoys-Squeakland-accessing') -----
+ repositoryVersion
+ 	^repositoryVersion ifNil: [0]!

Item was added:
+ ----- Method: SystemVersion>>repositoryVersion: (in category '*Etoys-Squeakland-accessing') -----
+ repositoryVersion: anInteger
+ 	repositoryVersion := anInteger
+ !

Item was added:
+ ----- Method: SystemWindow class>>rotateWindows (in category '*Etoys-Squeakland-top window') -----
+ rotateWindows
+ 	"Rotate the z-ordering of the windows."
+ 
+ 	ActiveEvent shiftPressed
+ 		ifTrue:
+ 			[self sendTopWindowBackOne]
+ 		ifFalse:
+ 			[self sendTopWindowToBack]!

Item was added:
+ ----- Method: SystemWindow class>>sendTopWindowBackOne (in category '*Etoys-Squeakland-top window') -----
+ sendTopWindowBackOne
+ 	"Rotate the window-list one downward, i.e., make the bottommost one be the active one, pushing the receiver to next-to-topmost."
+ 
+ 	| dows |
+ 	dows := ActiveWorld submorphs select: [:m | m isSystemWindow].
+ 	dows ifNotEmpty: [dows last expand;  comeToFront]!

Item was added:
+ ----- Method: SystemWindow>>collapsible (in category '*Etoys-Squeakland-resize/collapse') -----
+ collapsible
+ 	"Answer whether the receiver can be collapsed."
+ 
+ 	^ self isCollapsed not!

Item was added:
+ ----- Method: TTCFont class>>familyName:pointSize:emphasized: (in category '*Etoys-Squeakland-instance creation') -----
+ familyName: n pointSize: s emphasized: code
+ 
+ 	"(TTCFont familyName: 'BitstreamVeraSans' pointSize: 12 emphasis: 0)"
+ 	| t ret index |
+ 	t _ self registry at: n asSymbol ifAbsent: [#()].
+ 	t isEmpty ifTrue: [
+ 		t _ (TextConstants at: #DefaultTextStyle) fontArray.
+ 		ret _ t first.
+ 		ret pointSize >= s ifTrue: [^ ret emphasis: code].
+ 		index _ 2.
+ 		[index <= t size and: [(t at: index) pointSize <= s]] whileTrue: [
+ 			ret _ t at: index.
+ 			index _ index + 1.
+ 		].
+ 		^ ret emphasis: code.
+ 	].
+ 	^ ((TextStyle named: n) addNewFontSize: s) emphasis: code.
+ !

Item was added:
+ ----- Method: TTCFont>>hasGlyphWithFallbackOf: (in category '*Etoys-Squeakland-accessing') -----
+ hasGlyphWithFallbackOf: aCharacter
+ 
+ 	(self hasGlyphOf: aCharacter) ifTrue: [^ true].
+  	^ fallbackFont ifNotNil: [fallbackFont hasGlyphWithFallbackOf: aCharacter] ifNil: [false].
+ !

Item was added:
+ ----- Method: TTCFont>>setupDefaultFallbackTextStyleTo: (in category '*Etoys-Squeakland-friend') -----
+ setupDefaultFallbackTextStyleTo: aTextStyle
+ 
+ 	| fonts f |
+ 	aTextStyle isNil ifTrue: [^self].
+ 	fonts _ aTextStyle fontArray.
+ 	f _ fonts first.
+ 	f familyName = self familyName ifTrue: [^ self].
+ 	1 to: fonts size do: [:i |
+ 		self height >= (fonts at: i) height ifTrue: [f _ fonts at: i].
+ 	].
+ 	self fallbackFont: f.
+ 	self reset.
+ 
+ !

Item was added:
+ ----- Method: TTCFontSet class>>installExternalFontFileName: (in category '*Etoys-Squeakland-file out/in') -----
+ installExternalFontFileName: aFileName
+ "
+ 	TTCFontSet installExternalFontFileName: 'GreekTT.out'.
+ 	TTCFontSet installExternalFontFileName: 'RussianTT.out'.
+ 	TTCFontSet installExternalFontFileName: 'JapaneseTT.out'.
+ "
+ 	| f |
+ 	f _ FileStream readOnlyFileNamed: aFileName.
+ 	TTCFontSet newTextStyleFromSmartRefStream: (SmartRefStream on: f)..
+ 	f close.
+ !

Item was added:
+ ----- Method: TTCFontSet class>>makeSmartRefFilesFrom:encodingTag:ranges:outputFileName: (in category '*Etoys-Squeakland-file out/in') -----
+ makeSmartRefFilesFrom: fileNames encodingTag: anInteger ranges: ranges outputFileName: outputFile
+ "
+ 	| dir |
+ 	dir _ FileDirectory on: 'C:\tmp'.
+ 	dir _ FileDirectory on: '/usr/share/fonts/dejavu-lgc'.
+ 	((dir fileNames select: [:e | e endsWith: '.ttf']) collect: [:e | dir fullNameFor: e]).
+ 	TTCFontSet
+ 		makeSmartRefFilesFrom: ((dir fileNames select: [:e | e endsWith: '.ttf']) collect: [:e | dir fullNameFor: e])
+ 		encodingTag: GreekEnvironment leadingChar
+ 		ranges: EFontBDFFontReaderForRanges rangesForGreek
+ 		outputFileName: 'GreekTT.out'.
+ "
+ 	| f ref descriptions |
+ 	TTCFontReader encodingTag: anInteger.
+ 	descriptions _ fileNames collect: [:ttfFile | TTCFontSet newTextStyleFromTTFile: ttfFile encodingTag: anInteger ranges: ranges].
+ 
+ 	f _ FileStream newFileNamed: outputFile.
+ 	TextConstants at: #forceFontWriting put: true.
+ 	ref _ SmartRefStream on: f.
+ 	ref nextPutObjOnly: descriptions.
+ 	ref close.
+ 	TextConstants at: #forceFontWriting put: false.
+ 	f close.
+ 
+ "
+ 	When you load a copyrighted font, be careful not to distribute the result.
+ 	TTCFontSet
+ 		makeSmartRefFilesFrom: #('C:\Windows\Fonts\MSGothic.ttc')
+ 		encodingTag: JapaneseEnvironment leadingChar
+ 		ranges: EFontBDFFontReaderForRanges basicNew rangesForJapanese
+ 		outputFileName: 'JapaneseTT.out'
+ "!

Item was added:
+ ----- Method: TTCFontSet class>>newTextStyleFromSmartRefStream: (in category '*Etoys-Squeakland-file out/in') -----
+ newTextStyleFromSmartRefStream: ref
+ 
+ 	| descriptions |
+ 	descriptions _ TTFontDescription addFromSmartRefStream: ref.
+ 	descriptions do: [:desc | self newTextStyleFromTT: desc].!

Item was added:
+ ----- Method: TTFontDescription class>>addSetFromTTFile: (in category '*Etoys-Squeakland-instance creations') -----
+ addSetFromTTFile: fileName
+ "
+ 	Execute the following only if you know what you are doing.
+ 	self addFromTTFile: 'C:\WINDOWS\Fonts\msgothic.TTC'
+ "
+ 
+ 	| tt |
+ 	(fileName asLowercase endsWith: 'ttf') ifTrue: [
+ 		tt _ TTCFontReader readTTFFrom: (FileStream readOnlyFileNamed: fileName).
+ 	] ifFalse: [
+ 		tt _ TTCFontReader readFrom: (FileStream readOnlyFileNamed: fileName).
+ 	].
+ 
+ 	^ self addToDescription: tt.
+ !

Item was changed:
  ----- Method: TabbedPalette>>viewMorph: (in category '*Etoys-viewer tab') -----
  viewMorph: aMorph
  	"The receiver is expected to have a viewer tab; select it, and target it to aMorph"
  	| aPlayer aViewer oldOwner |
  	((currentPage isKindOf: Viewer) and: [currentPage scriptedPlayer == aMorph player])
  		ifTrue:
  			[^ self].
+ 	oldOwner _ owner.
- 	oldOwner := owner.
  	self delete.
  	self visible: false.
+ 	aPlayer _ aMorph assuredPlayer.
- 	aPlayer := aMorph assuredPlayer.
  	self showNoPalette.
+ 	aViewer _  StandardViewer new initializeFor: aPlayer barHeight: 0.
- 	aViewer :=  StandardViewer new initializeFor: aPlayer barHeight: 0.
  	aViewer enforceTileColorPolicy.
  	self showNoPalette.
  	currentPage ifNotNil: [currentPage delete].
+ 	self addMorphBack: (self currentPage: aViewer beSticky).
- 	self addMorphBack: (currentPage := aViewer beSticky).
  	self snapToEdgeIfAppropriate.
  	tabsMorph highlightTab: nil.
  	self visible: true.
  	oldOwner addMorphFront: self.
  	self world startSteppingSubmorphsOf: aViewer.
  	self layoutChanged!

Item was added:
+ Model subclass: #TelnetMachine
+ 	instanceVariableNames: 'hostname port socket outputBuffer processingCommand commandChar lastInputChar displayLines cursorX cursorY foregroundColor displayMode commandParams requestedRemoteEcho remoteEchoAgreed'
+ 	classVariableNames: 'CSSpecialChars DOChar DONTChar IAC OPTEcho WILLChar WONTChar'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-TelNet WordNet'!
+ 
+ !TelnetMachine commentStamp: '<historical>' prior: 0!
+ The beginnings of a telnet terminal, for telnetting to other hosts. 
+ 
+ 
+ NOTE - it should separate out the VT100 code to a separate class some time....
+ !

Item was added:
+ ----- Method: TelnetMachine class>>initialize (in category 'initialization') -----
+ initialize
+ 	"TelnetMachine initialize"
+ 	WILLChar _ 251 asCharacter.
+ 	WONTChar _ 252 asCharacter.
+ 	DOChar _ 253 asCharacter.
+ 	DONTChar _ 254 asCharacter.
+ 	IAC _ 255 asCharacter.
+ 
+ 	OPTEcho _ 1 asCharacter.
+ 
+ 
+ 	"set of characters that need special processing"
+ 	CSSpecialChars _ CharacterSet 
+ 		with: Character escape 
+ 		with: Character cr
+ 		with: Character lf
+ 		with: Character tab.
+ 	!

Item was added:
+ ----- Method: TelnetMachine class>>open (in category 'user interface') -----
+ open
+ 	"TelnetMachine open"
+ 	| machine win displayMorph inputMorph |
+ 	Smalltalk isMorphic ifFalse: [ ^self notYetImplemented ].
+ 	
+ 	machine _ self new.
+ 
+ 	win _ SystemWindow labelled: 'telnet'.
+ 	win model: machine.
+ 
+ 	displayMorph _ PluggableTextMorph on: machine text: #displayBuffer accept: nil readSelection: #displayBufferSelection menu: #menu:shifted:.	
+ 	displayMorph color: Color black.
+ 
+ 	inputMorph _ PluggableTextMorph on: machine text: nil accept: #sendLine:.
+ 	inputMorph acceptOnCR: true.
+ 
+ 	win addMorph: displayMorph frame: (0 at 0 extent: 1 at 0.9).
+ 	win addMorph: inputMorph frame: (0 at 0.9 extent: 1 at 0.1).
+ 
+ 	displayMorph color: Color black.
+ 
+ 	win openInWorld.
+ !

Item was added:
+ ----- Method: TelnetMachine>>addBoringStringInNormalMode: (in category 'screen management') -----
+ addBoringStringInNormalMode: aString
+ 	"add a string with no special characters, and assuming we are already in #normal mode"
+ 	|line inPos space amt |
+ 
+ aString do: [ :c | self displayChar: c ].
+ true ifTrue: [ ^self ].
+ 	line _ displayLines at: cursorY.
+ 	inPos _ 1.
+ 
+ 	[ inPos <= aString size ] whileTrue: [
+ 		"copy a line's worth"
+ 		space _ 80 - cursorX + 1.
+ 		amt _ space min: (aString size - inPos + 1).
+ 		line replaceFrom: cursorX to: cursorX+amt-1 with: aString startingAt: inPos.
+ 		line addAttribute: (TextColor color: foregroundColor) from: cursorX to: cursorX+amt-1.
+ 		inPos _ inPos + amt.
+ 
+ 		"update cursor"
+ 		cursorX _ cursorX + amt.
+ 		self possiblyWrapCursor.
+ 
+ 	].
+ !

Item was added:
+ ----- Method: TelnetMachine>>connect (in category 'IO') -----
+ connect
+ 	"connect to the name host"
+ 	| addr |
+ 	self isConnected ifTrue: [ self disconnect ].
+ 
+ 	Socket initializeNetwork.
+ 
+ 	addr _ NetNameResolver addressForName: hostname.
+ 	addr ifNil: [ self error: 'could not find address for ', hostname ].
+ 
+ 	socket _ Socket new.
+ 	
+ 	[socket connectTo: addr port: port]
+ 		on: ConnectionTimedOut
+ 		do: [:ex | self error: 'connection failed' ].
+ 
+ 	
+ 	requestedRemoteEcho _ true.
+ 	self do: OPTEcho.!

Item was added:
+ ----- Method: TelnetMachine>>disconnect (in category 'IO') -----
+ disconnect
+ 	self isConnected ifTrue: [
+ 		Transcript show: 'disconnecting from ', hostname.
+ 		socket disconnect ].!

Item was added:
+ ----- Method: TelnetMachine>>displayBuffer (in category 'access') -----
+ displayBuffer
+ 	"the 'screen' of the terminal"
+ 	^Text streamContents: [ :s |
+ 		displayLines do: [ :line |
+ 			s nextPutAll: line.
+ 			s cr. ] ]!

Item was added:
+ ----- Method: TelnetMachine>>displayBufferSelection (in category 'access') -----
+ displayBufferSelection
+ 	"where the selection should be in the display buffer.  It should be where the cursor is"
+ 	| pos |
+ 	pos _ cursorY * 81 + cursorX - 82.
+ 	^pos+1 to: pos!

Item was added:
+ ----- Method: TelnetMachine>>displayChar: (in category 'screen management') -----
+ displayChar: c
+ 	| line |
+ 
+ 	displayMode = #sawEscape ifTrue: [ 
+ 		^self displayCharSawEscape: c ].
+ 
+ 	displayMode = #gatheringParameters ifTrue: [
+ 		^self displayCharGatheringParameters: c ].
+ 
+ 	c = Character escape ifTrue: [
+ 		displayMode _ #sawEscape.
+ 		^self ].
+ 
+ 	c = Character cr ifTrue: [
+ 		"go back to the beginning of the line"
+ 		cursorX _ 1.
+ 		^self ].
+ 
+ 	c = Character lf ifTrue: [
+ 		"go to the next line"
+ 		cursorY _ cursorY + 1.
+ 		cursorY > 25 ifTrue: [
+ 			self scrollScreenBack: 1.
+ 			cursorY _ 25 ].
+ 		^self ].
+ 
+ 	c = Character tab ifTrue: [
+ 		"move to the next tab stop"
+ 		cursorX _ cursorX + 8 // 8 * 8.
+ 		self possiblyWrapCursor.
+ 		^self ].
+ 
+ 	"default: display the character"
+ 	line _ displayLines at: cursorY.
+ 	line at: cursorX put: c.
+ 	line addAttribute: (TextColor color: foregroundColor) from: cursorX to: cursorX.
+ 		
+ 	cursorX _ cursorX + 1.
+ 	self possiblyWrapCursor.!

Item was added:
+ ----- Method: TelnetMachine>>displayCharGatheringParameters: (in category 'screen management') -----
+ displayCharGatheringParameters: c
+ 	"display a character from the mode #gatheringParameters"
+ 
+ 	| colorName |
+ 	c isDigit  ifTrue: [
+ 		"add a digit to the last parameter"
+ 		commandParams at: commandParams size put:
+ 			(commandParams last * 10 + c digitValue).
+ 		^self ].
+ 
+ 	c = $; ifTrue: [
+ 		"end of a parameter; begin another one"
+ 		commandParams add: 0.
+ 		^self ].
+ 
+ 	c = $m ifTrue: [
+ 		"change display modes"
+ 		displayMode _ #normal.
+ 
+ 		commandParams do: [ :p |
+ 			p = 0 ifTrue: [
+ 				"reset"
+ 				foregroundColor _ Color white ].
+ 			(p >= 30 and: [ p <= 37 ]) ifTrue: [
+ 				"change color"
+ 				colorName _ #(gray red green yellow blue blue cyan white) at: (p - 29).
+ 				foregroundColor _ Color perform: colorName. ] ].
+ 
+ 		^self ].
+ 
+ 
+ 	"unrecognized character"
+ 	displayMode _ #normal.
+ 	^self displayChar: c!

Item was added:
+ ----- Method: TelnetMachine>>displayCharSawEscape: (in category 'screen management') -----
+ displayCharSawEscape: c
+ 	"display a character from the mode #sawEscape"
+ 
+ 	c = $[ ifTrue: [
+ 		commandParams _ OrderedCollection with: 0.
+ 		displayMode _ #gatheringParameters.
+ 		^self ].
+ 	
+ 	displayMode _ #normal.
+ 	^self displayChar: c!

Item was added:
+ ----- Method: TelnetMachine>>displayString: (in category 'screen management') -----
+ displayString: aString
+ 	"add aString to the display"
+ 	|pos specialIdx |
+ 
+ 	pos _ 1. 	"pos steps through aString"
+ 
+ 	[ pos <= aString size ] whileTrue: [
+ 		displayMode = #normal ifTrue: [
+ 			"try to display a whole hunk of text at once"
+ 			specialIdx _ aString indexOfAnyOf: CSSpecialChars startingAt: pos ifAbsent: [ aString size + 1 ].
+ 			specialIdx > pos ifTrue: [
+ 				self addBoringStringInNormalMode: (aString copyFrom: pos to: specialIdx-1).
+ 				pos _ specialIdx. ] ].
+ 
+ 			pos <= aString size ifTrue: [
+ 				"either a special has been seen, or we're in a special mode"
+ 				self displayChar: (aString at: pos).
+ 				pos _ pos + 1. ].
+ 	].
+ 
+ !

Item was added:
+ ----- Method: TelnetMachine>>do: (in category 'private') -----
+ do: optionNo
+ 	"request that the remote side does optionNo"
+ 	self sendChar: IAC.
+ 	self sendChar: DOChar.
+ 	self sendChar: optionNo asCharacter!

Item was added:
+ ----- Method: TelnetMachine>>dont: (in category 'private') -----
+ dont: optionNo
+ 	"demand that the remote side doesn't do optionNo"
+ 	self sendChar: IAC.
+ 	self sendChar: DONTChar.
+ 	self sendChar: optionNo asCharacter!

Item was added:
+ ----- Method: TelnetMachine>>initialize (in category 'private') -----
+ initialize
+ 	outputBuffer _ WriteStream on: String new.
+ 	port _ 23.
+ 	processingCommand _ false.
+ 	displayLines _ (1 to: 25) asOrderedCollection collect: [ :i |
+ 		Text new: 80 withAll: Character space ].
+ 	cursorX _ 1.
+ 	cursorY _ 1.
+ 	foregroundColor _ Color white.
+ 	displayMode _ #normal.
+ 	requestedRemoteEcho _ false.
+ 	remoteEchoAgreed _ false.
+ 	hostname _ ''.!

Item was added:
+ ----- Method: TelnetMachine>>isConnected (in category 'access') -----
+ isConnected
+ 	"answer whether we are connected to a remote host"
+ 	^socket ~~ nil and: [ socket isValid and: [ socket isConnected ] ]!

Item was added:
+ ----- Method: TelnetMachine>>menu:shifted: (in category 'menu') -----
+ menu: aMenu shifted: shiftState
+ 
+ 	aMenu labels: 
+ 'set host name
+ set port
+ connect
+ disconnect' lines: #() selections: #(setHostName setPort connect disconnect).
+ 	^aMenu!

Item was added:
+ ----- Method: TelnetMachine>>perform:orSendTo: (in category 'menu') -----
+ perform: aSelector orSendTo: anObject
+ 	^self perform: aSelector!

Item was added:
+ ----- Method: TelnetMachine>>port: (in category 'access') -----
+ port: anInteger
+ 	"set which port to connect to"
+ 	port _ anInteger!

Item was added:
+ ----- Method: TelnetMachine>>possiblyWrapCursor (in category 'screen management') -----
+ possiblyWrapCursor
+ 	"if the cursor has gone past the right margin, then wrap"
+ 
+ 	cursorX > 80 ifTrue: [
+ 		cursorX _ 1.
+ 		cursorY _ cursorY + 1.
+ 		cursorY > 25 ifTrue: [
+ 			cursorY _ 25.
+ 			self scrollScreenBack: 1 ].
+ 	].
+ !

Item was added:
+ ----- Method: TelnetMachine>>processDo: (in category 'private') -----
+ processDo: optionChar
+ 	"we don't do anything"
+ 	self wont: optionChar!

Item was added:
+ ----- Method: TelnetMachine>>processDont: (in category 'private') -----
+ processDont: char
+ 	"okay, fine by us, we won't do it..."!

Item was added:
+ ----- Method: TelnetMachine>>processIO (in category 'IO') -----
+ processIO
+ 	"should be called periodically--this actually sends and recieves some bytes over the network"
+ 	| amountSent |
+ 
+ 
+ 	self isConnected ifFalse: [ ^ self ].
+ 
+ 	outputBuffer _ outputBuffer contents.	"convert to String for convenience in the loop.  still not as optimal as it could be...."
+ 	[outputBuffer size > 0 and: [ socket sendDone ]] whileTrue: [ 
+ 		"do some output"
+ 		amountSent _ socket sendSomeData: outputBuffer.
+ 		outputBuffer _ outputBuffer copyFrom: amountSent+1 to: outputBuffer size. ].
+ 	outputBuffer _ WriteStream on: outputBuffer.
+ 
+ 	"do some input"
+ 	self processInput: socket receiveAvailableData.!

Item was added:
+ ----- Method: TelnetMachine>>processInput: (in category 'private') -----
+ processInput: aString
+ 	"process input from the network"
+ 	| newDisplayText |
+ 
+ 	(processingCommand not and: [(aString indexOf: IAC) = 0]) ifTrue: [
+ 		"no commands here--display the whole string"
+ 		self displayString: aString.
+ 		self changed: #displayBuffer.
+ 		^self ].
+ 
+ 	Transcript show: 'slow.'; cr.
+ 
+ 	newDisplayText _ WriteStream on: String new.
+ 
+ 	aString do: [ :c |
+ 		processingCommand ifTrue: [
+ 			"an IAC has been seen"
+ 			commandChar
+ 				ifNil: [ 
+ 					"c is the command character.  act immediately if c=IAC, otherwise save it and wait fro the next character"
+ 					commandChar _ c.  
+ 					(commandChar = IAC) ifTrue: [ self displayChar: IAC. processingCommand _ false ] ]
+ 				ifNotNil: [
+ 					commandChar == DOChar ifTrue: [ self processDo: c. ].
+ 					commandChar == DONTChar ifTrue: [ self processDont: c ].
+ 					commandChar == WILLChar ifTrue: [ self processWill: c ].
+ 					commandChar == WONTChar ifTrue: [ self processWont: c ].
+ 					processingCommand _ false.  ] ]
+ 		ifFalse: [
+ 			"normal mode"
+ 			c = IAC ifTrue: [ processingCommand _ true.  commandChar _ nil ] ifFalse: [
+ 			  newDisplayText nextPut: c ] ] ].
+ 
+ 
+ 	self displayString: newDisplayText contents.
+ 
+ 	self changed: #displayBuffer
+ !

Item was added:
+ ----- Method: TelnetMachine>>processTyping: (in category 'sending data') -----
+ processTyping: aString
+ 	"process aString as if it were typed"
+ 	outputBuffer nextPutAll: aString asString.
+ 	remoteEchoAgreed ifFalse: [ self displayString: aString asString ].
+ 	^true!

Item was added:
+ ----- Method: TelnetMachine>>processWill: (in category 'private') -----
+ processWill: optionChar
+ 	optionChar == OPTEcho ifTrue: [
+ 		requestedRemoteEcho ifTrue: [
+ 			remoteEchoAgreed _ true ]
+ 		ifFalse: [
+ 			"they are offering remote echo, though we haven't asked.  Answer: oh yes."
+ 			self do: OPTEcho.
+ 			requestedRemoteEcho _ true.
+ 			remoteEchoAgreed _ true. ].
+ 	^self  ].
+ 	
+ 
+ 	"they've requested an unknown option.  reject it"
+ 	self dont: optionChar.!

Item was added:
+ ----- Method: TelnetMachine>>processWont: (in category 'private') -----
+ processWont: optionChar
+ 	optionChar == OPTEcho ifTrue: [
+ 		remoteEchoAgreed _ false.
+ 		requestedRemoteEcho _ false.
+ 	^self  ].
+ 	
+ !

Item was added:
+ ----- Method: TelnetMachine>>release (in category 'IO') -----
+ release
+ 	self isConnected ifTrue:[ self disconnect ]!

Item was added:
+ ----- Method: TelnetMachine>>remoteHost: (in category 'access') -----
+ remoteHost: aString
+ 	"set which host to connect to"
+ 	hostname _ aString!

Item was added:
+ ----- Method: TelnetMachine>>scrollScreenBack: (in category 'screen management') -----
+ scrollScreenBack: numLines
+ 	"scrolls the screen up by the number of lines.  The cursor isn't moved"
+ 	numLines timesRepeat: [ displayLines removeFirst ].
+ 	numLines timesRepeat: [
+ 		displayLines addLast: (Text new: 80 withAll: Character space) ].!

Item was added:
+ ----- Method: TelnetMachine>>sendChar: (in category 'private') -----
+ sendChar: char
+ 	"queue a character for sending over the network"
+ 	outputBuffer nextPut: char!

Item was added:
+ ----- Method: TelnetMachine>>sendLine: (in category 'sending data') -----
+ sendLine: aString
+ 	"send a line, along with a newline"
+ 	self processTyping: aString, String crlf.
+ 	^true!

Item was added:
+ ----- Method: TelnetMachine>>setHostName (in category 'menu') -----
+ setHostName
+ 	| newHostname |
+ 	newHostname _ FillInTheBlank request: 'host to connect to' initialAnswer: hostname.
+ 	newHostname size > 0 ifTrue: [ hostname _ newHostname ].!

Item was added:
+ ----- Method: TelnetMachine>>setPort (in category 'menu') -----
+ setPort
+ 	| portString |
+ 	portString _ port printString.
+ 	portString _ FillInTheBlank request: 'port to connect on' initialAnswer: portString.
+ 	portString _ portString withBlanksTrimmed.
+ 	portString isEmpty ifFalse: [ port _ portString asNumber asInteger ].!

Item was added:
+ ----- Method: TelnetMachine>>step (in category 'IO') -----
+ step
+ 	self processIO!

Item was added:
+ ----- Method: TelnetMachine>>wantsSteps (in category 'IO') -----
+ wantsSteps
+ 	^true!

Item was added:
+ ----- Method: TelnetMachine>>will: (in category 'private') -----
+ will: optionNo
+ 	"request that we do optionNo"
+ 	self sendChar: IAC.
+ 	self sendChar: WILLChar.
+ 	self sendChar: optionNo asCharacter!

Item was added:
+ ----- Method: TelnetMachine>>wont: (in category 'private') -----
+ wont: optionNo
+ 	"demand that we won't do optionNo"
+ 	self sendChar: IAC.
+ 	self sendChar: WONTChar.
+ 	self sendChar: optionNo asCharacter!

Item was added:
+ ----- Method: TempVariableNode>>defaultBlockType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultBlockType: t1 
+ 	^ #default!

Item was added:
+ ----- Method: TempVariableNode>>defaultMessageType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultMessageType
+ 	^ #none!

Item was added:
+ ----- Method: TempVariableNode>>firstInReceivers: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ firstInReceivers: t1 
+ 	^ t1 first!

Item was added:
+ ----- Method: TempVariableNode>>initialNil (in category '*Etoys-Tweak-Kedama-Generated') -----
+ initialNil
+ 	^ nil!

Item was added:
+ ----- Method: TempVariableNode>>isArg: (in category '*Etoys-Squeakland-initialize-release') -----
+ isArg: aBoolean
+ 
+ 	isAnArg _ aBoolean.
+ 	isAnArg ifTrue: [hasDefs _ true]!

Item was added:
+ ----- Method: TempVariableNode>>isStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isStmt: t1 
+ 	^ t1 = #top
+ 		or: [t1 = #condition]!

Item was added:
+ ----- Method: TempVariableNode>>isTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTest: t1 parentNode: t2 
+ 	t1 = true
+ 		ifTrue: [^ true].
+ 	^ (t2 isMemberOf: MessageNode)
+ 		and: [t2 receiver = self
+ 				and: [t2 messageType value = #condition]]!

Item was added:
+ ----- Method: TempVariableNode>>isTopStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmt: t1 
+ 	t1 = nil
+ 		ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: TempVariableNode>>rcvr: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr: t1 
+ 	^ t1!

Item was added:
+ ----- Method: TempVariableNode>>rewriteVariable:with:rewriteInfo: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rewriteVariable: t1 with: t2 rewriteInfo: t3 
+ 	t2
+ 		ifNil: [^ nil].
+ 	t2 first = t1
+ 		ifTrue: [^ t3].
+ 	^ nil!

Item was added:
+ ----- Method: TempVariableNode>>thisNode (in category '*Etoys-Tweak-Kedama-Generated') -----
+ thisNode
+ 	^ self!

Item was added:
+ ----- Method: TempVariableNode>>transfer: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 
+ 	^ t1!

Item was added:
+ ----- Method: TempVariableNode>>variableReceiver: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ variableReceiver: t1 
+ 	| t2 t3 |
+ 	(self key isKindOf: LookupKey)
+ 		ifTrue: [^ self key value].
+ 	t3 := self key.
+ 	t2 := Compiler new
+ 				evaluate: t3 asString
+ 				in: nil
+ 				to: t1
+ 				notifying: nil
+ 				ifFail: []
+ 				logged: false.
+ 	^ t2!

Item was added:
+ Debugger subclass: #TestCaseDebugger
+ 	instanceVariableNames: 'doneSemaphore'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-SUnit'!

Item was added:
+ ----- Method: TestCaseDebugger>>doneSemaphore: (in category 'as yet unclassified') -----
+ doneSemaphore: aSemaphore
+ 	doneSemaphore _ aSemaphore.!

Item was added:
+ ----- Method: TestCaseDebugger>>windowIsClosing (in category 'as yet unclassified') -----
+ windowIsClosing
+ 	super windowIsClosing.
+ 	doneSemaphore ifNotNil: [ doneSemaphore signal ]!

Item was added:
+ AlignmentMorph subclass: #Tetris
+ 	instanceVariableNames: 'board scoreDisplay'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!
+ 
+ !Tetris commentStamp: '<historical>' prior: 0!
+ This is a port of JTetris.java 1.0.0.
+ 
+ How to start:
+ choose new morph.../Games/Tetris
+ 
+ How to play:
+ 1) using buttons
+ 2) using keyboard:
+ 	drop - spacebar
+ 	move to left - left arrow
+ 	move to right - right arrow
+ 	rotate clockwise - up arrow
+ 	rotate anticlockwise - down arrow
+ NOTE: mouse must be over Tetris!

Item was added:
+ ----- Method: Tetris class>>colors (in category 'as yet unclassified') -----
+ colors
+ 
+ 	^{
+ 		Color r: 0.5 g: 0 b: 0.
+ 		Color r: 0 g: 0.5 b: 0.
+ 		Color r: 0 g: 0 b: 0.5.
+ 		Color r: 0.5 g: 0.5 b: 0.
+ 		Color r: 0.5 g: 0 b: 0.5.
+ 		Color r: 0 g: 0.5 b: 0.5
+ 	}
+ !

Item was added:
+ ----- Method: Tetris class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self partName:	'Tetris' translatedNoop
+ 		categories:		#()
+ 		documentation:	'Tetris, yes Tetris' translatedNoop!

Item was added:
+ ----- Method: Tetris>>buildButtonTarget:label:selector:help: (in category 'initialization') -----
+ buildButtonTarget: aTarget label: aLabel selector: aSelector help: aString
+ 
+ 	^self rowForButtons
+ 		addMorph: (
+ 			SimpleButtonMorph new 
+ 				target: aTarget;
+ 				label: aLabel;
+ 				actionSelector: aSelector;
+ 				borderColor: #raised;
+ 				borderWidth: 2;
+ 				color: color
+ 		)
+ 
+ !

Item was added:
+ ----- Method: Tetris>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color lightGray!

Item was added:
+ ----- Method: Tetris>>handlesKeyboard: (in category 'event handling') -----
+ handlesKeyboard: evt
+ 	^true!

Item was added:
+ ----- Method: Tetris>>handlesMouseOver: (in category 'event handling') -----
+ handlesMouseOver: evt
+ 	^true
+ !

Item was added:
+ ----- Method: Tetris>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	board _ TetrisBoard new game: self.
+ 	self listDirection: #topToBottom;
+ 	  wrapCentering: #center;
+ 	  vResizing: #shrinkWrap;
+ 	  hResizing: #shrinkWrap;
+ 	  layoutInset: 3;
+ 	  addMorphBack: self makeGameControls;
+ 		 addMorphBack: self makeMovementControls;
+ 		 addMorphBack: self showScoreDisplay;
+ 		 addMorphBack: board.
+ 	board newGame!

Item was added:
+ ----- Method: Tetris>>keyStroke: (in category 'event handling') -----
+ keyStroke: evt
+ 
+ 	| charValue |
+ 	charValue _ evt keyCharacter asciiValue.
+ 	charValue = 28 ifTrue: [board moveLeft].
+ 	charValue = 29 ifTrue: [board moveRight].
+ 	charValue = 30 ifTrue: [board rotateClockWise].
+ 	charValue = 31 ifTrue: [board rotateAntiClockWise].
+ 	charValue = 32 ifTrue: [board dropAllTheWay].
+ !

Item was added:
+ ----- Method: Tetris>>makeGameControls (in category 'initialization') -----
+ makeGameControls
+ 	^ self rowForButtons
+ 		addMorph: (self
+ 				buildButtonTarget: self
+ 				label: 'Quit' translated
+ 				selector: #delete
+ 				help: 'quit' translated);
+ 		
+ 		addMorph: (self
+ 				buildButtonTarget: board
+ 				label: 'Pause' translated
+ 				selector: #pause
+ 				help: 'pause' translated);
+ 		
+ 		addMorph: (self
+ 				buildButtonTarget: board
+ 				label: 'New game' translated
+ 				selector: #newGame
+ 				help: 'new game' translated)!

Item was added:
+ ----- Method: Tetris>>makeMovementControls (in category 'initialization') -----
+ makeMovementControls
+ 	^ self rowForButtons
+ 		addMorph: (self
+ 				buildButtonTarget: board
+ 				label: '->'
+ 				selector: #moveRight
+ 				help: 'move to the right' translated);
+ 		
+ 		addMorph: (self
+ 				buildButtonTarget: board
+ 				label: ' ) '
+ 				selector: #rotateClockWise
+ 				help: 'rotate clockwise' translated);
+ 		
+ 		addMorph: (self
+ 				buildButtonTarget: board
+ 				label: ' | '
+ 				selector: #dropAllTheWay
+ 				help: 'drop' translated);
+ 		
+ 		addMorph: (self
+ 				buildButtonTarget: board
+ 				label: ' ( '
+ 				selector: #rotateAntiClockWise
+ 				help: 'rotate anticlockwise' translated);
+ 		
+ 		addMorph: (self
+ 				buildButtonTarget: board
+ 				label: '<-'
+ 				selector: #moveLeft
+ 				help: 'move to the left' translated)!

Item was added:
+ ----- Method: Tetris>>mouseEnter: (in category 'event handling') -----
+ mouseEnter: evt
+         evt hand newKeyboardFocus: self!

Item was added:
+ ----- Method: Tetris>>rowForButtons (in category 'initialization') -----
+ rowForButtons
+ 
+ 	^AlignmentMorph newRow
+ 		color: color;
+ 		borderWidth: 0;
+ 		layoutInset: 3;
+ 		vResizing: #shrinkWrap;
+ 		wrapCentering: #center
+ !

Item was added:
+ ----- Method: Tetris>>score: (in category 'events') -----
+ score: anInteger
+ 
+ 	scoreDisplay value: anInteger!

Item was added:
+ ----- Method: Tetris>>showScoreDisplay (in category 'initialization') -----
+ showScoreDisplay
+ 	^ self rowForButtons hResizing: #shrinkWrap;
+ 		
+ 		addMorph: (self wrapPanel: ((scoreDisplay := LedMorph new) digits: 5;
+ 					 extent: 4 * 10 @ 15) label: 'Score:' translated)!

Item was added:
+ ----- Method: Tetris>>wrapPanel:label: (in category 'initialization') -----
+ wrapPanel: anLedPanel label: aLabel
+ 	"wrap an LED panel in an alignmentMorph with a label to its left"
+ 
+ 	^self rowForButtons
+ 		color: color lighter;
+ 		addMorph: anLedPanel;
+ 		addMorph: (StringMorph contents: aLabel)
+ !

Item was added:
+ Morph subclass: #TetrisBlock
+ 	instanceVariableNames: 'angle shapeInfo board baseCellNumber'
+ 	classVariableNames: 'ShapeChoices'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!

Item was added:
+ ----- Method: TetrisBlock class>>flipShapes: (in category 'as yet unclassified') -----
+ flipShapes: anArray
+ 
+ 	^OrderedCollection new 
+ 		add: anArray;
+ 		add: (anArray collect: [ :each | each y negated @ each x]);
+ 		add: (anArray collect: [ :each | each x negated @ each y negated]);
+ 		add: (anArray collect: [ :each | each y @ each x negated]);
+ 		yourself
+ 	
+ !

Item was added:
+ ----- Method: TetrisBlock class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 
+ 	^false!

Item was added:
+ ----- Method: TetrisBlock class>>shapeChoices (in category 'as yet unclassified') -----
+ shapeChoices
+ 
+ 	^ ShapeChoices ifNil: [
+ 		ShapeChoices _ {
+ 			{ {  0 @ 0 .  1 @ 0 .  0 @ 1 .  1 @ 1  } }.	"square - one is sufficient here"
+ 			self flipShapes: {  0 @  0 . -1 @  0 .  1 @  0 .  0 @ -1  }.	"T"
+ 			{ 
+ 				{  0 @ 0 . -1 @ 0 .  1 @ 0 .  2 @ 0  }.
+ 				{  0 @ 0 .  0 @-1 .  0 @ 1 .  0 @ 2  } 	"long - two are sufficient here"
+ 			}.
+ 			self flipShapes: { 0 @ 0 .  0 @ -1 .  0 @  1 .  1 @  1  }.	"L"
+ 			self flipShapes: { 0 @ 0 .  0 @ -1 .  0 @  1 . -1 @  1  }.	"inverted L"
+ 			self flipShapes: { 0 @ 0 . -1 @  0 .  0 @ -1 .  1 @ -1  }.	"S"
+ 			self flipShapes: {  0 @ 0 .  1 @ 0 .  0 @ -1 . -1 @ -1  } "Z"
+ 		}.
+ 	]
+ !

Item was added:
+ ----- Method: TetrisBlock>>board: (in category 'as yet unclassified') -----
+ board: theBoard
+ 
+ 	board _ theBoard.
+ 	4 timesRepeat: [
+ 		self addMorph: (
+ 			RectangleMorph new
+ 				color: color;
+ 				extent: board cellSize;
+ 				borderRaised
+ 		 )
+ 	].
+ 	self positionCellMorphs.!

Item was added:
+ ----- Method: TetrisBlock>>defaultBounds (in category 'initialization') -----
+ defaultBounds
+ "answer the default bounds for the receiver"
+ 	^ (2 @ 2) negated extent: 1 @ 1!

Item was added:
+ ----- Method: TetrisBlock>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Tetris colors atRandom!

Item was added:
+ ----- Method: TetrisBlock>>dropByOne (in category 'as yet unclassified') -----
+ dropByOne
+  
+ 	^self moveDeltaX: 0 deltaY: 1 deltaAngle: 0!

Item was added:
+ ----- Method: TetrisBlock>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	
+ 	"keep this puppy out of sight"
+ 	shapeInfo _ self class shapeChoices atRandom.
+ 	baseCellNumber _ 4 atRandom + 2 @ 1.
+ 	angle _ 4 atRandom!

Item was added:
+ ----- Method: TetrisBlock>>moveDeltaX:deltaY:deltaAngle: (in category 'as yet unclassified') -----
+ moveDeltaX: deltaX deltaY: deltaY deltaAngle: deltaAngle 
+ 
+ 	| delta |
+ 
+ 	delta _ deltaX @ deltaY.
+ 	(shapeInfo atWrap: angle + deltaAngle) do: [ :offsetThisCell | 
+ 		(board emptyAt: baseCellNumber + offsetThisCell + delta) ifFalse: [^ false]
+ 	].
+ 	baseCellNumber _ baseCellNumber + delta.
+ 	angle _ angle + deltaAngle - 1 \\ 4 + 1.
+ 	self positionCellMorphs.
+ 	^ true !

Item was added:
+ ----- Method: TetrisBlock>>positionCellMorphs (in category 'as yet unclassified') -----
+ positionCellMorphs
+ 
+ 	(shapeInfo atWrap: angle) withIndexDo: [ :each :index |
+ 		(submorphs at: index)
+ 			position: (board originForCell: baseCellNumber + each)
+ 	].
+ 	fullBounds _ nil.
+ 	self changed.
+ 	 
+ !

Item was added:
+ PasteUpMorph subclass: #TetrisBoard
+ 	instanceVariableNames: 'paused gameOver delay score currentBlock game'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!

Item was added:
+ ----- Method: TetrisBoard class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 
+ 	^false!

Item was added:
+ ----- Method: TetrisBoard>>cellSize (in category 'as yet unclassified') -----
+ cellSize
+ 
+ 	^12 at 12!

Item was added:
+ ----- Method: TetrisBoard>>checkForFullRows (in category 'other') -----
+ checkForFullRows
+ 
+ 	| targetY morphsInRow bonus |
+ 	self numRows to: 2 by: -1 do: [ :row |
+ 		targetY _ (self originForCell: 1 at row) y.
+ 		[
+ 			morphsInRow _ self submorphsSatisfying: [ :each | each top = targetY].
+ 			morphsInRow size = self numColumns
+ 		] whileTrue: [
+ 			bonus _ (morphsInRow collect: [:each | each color]) asSet size = 1 
+ 				ifTrue: [1000] 
+ 				ifFalse: [100].
+ 			self score: score + bonus.
+ 			submorphs copy do: [ :each |
+ 				each top = targetY ifTrue: [
+ 					each delete
+ 				].
+ 				each top < targetY ifTrue: [
+ 					each position: each position + (0 at self cellSize y)
+ 				].
+ 			].
+ 		].
+ 	].
+ 
+ !

Item was added:
+ ----- Method: TetrisBoard>>defaultBounds (in category 'initialization') -----
+ defaultBounds
+ "answer the default bounds for the receiver"
+ 	^ 0 @ 0 extent: self numColumns @ self numRows * self cellSize + (1 @ 1)!

Item was added:
+ ----- Method: TetrisBoard>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color
+ 		  lightBlue!

Item was added:
+ ----- Method: TetrisBoard>>dropAllTheWay (in category 'button actions') -----
+ dropAllTheWay
+ 
+ 	self running ifFalse: [^ self].
+ 	[currentBlock dropByOne] whileTrue: [
+ 		self score: score + 1
+ 	].
+ !

Item was added:
+ ----- Method: TetrisBoard>>emptyAt: (in category 'data') -----
+ emptyAt: aPoint
+ 
+ 	| cellOrigin |
+ 	(aPoint x between: 1 and: self numColumns) ifFalse: [^ false].
+ 	(aPoint y < 1) ifTrue: [^ true].	"handle early phases"
+ 	(aPoint y <= self numRows) ifFalse: [^ false].
+ 	cellOrigin _ self originForCell: aPoint.
+ 	^(self submorphsSatisfying: [ :each | each topLeft = cellOrigin]) isEmpty
+ 
+ !

Item was added:
+ ----- Method: TetrisBoard>>game: (in category 'accessing') -----
+ game: aTetris
+ 
+ 	game _ aTetris!

Item was added:
+ ----- Method: TetrisBoard>>moveLeft (in category 'button actions') -----
+ moveLeft
+ 
+ 	self running ifFalse: [^ self].
+ 	currentBlock moveDeltaX: -1 deltaY: 0 deltaAngle: 0.
+ !

Item was added:
+ ----- Method: TetrisBoard>>moveRight (in category 'button actions') -----
+ moveRight
+ 
+ 	self running ifFalse: [^ self].
+ 	currentBlock moveDeltaX: 1 deltaY: 0 deltaAngle: 0.
+ !

Item was added:
+ ----- Method: TetrisBoard>>newGame (in category 'button actions') -----
+ newGame
+ 
+ 	self removeAllMorphs.
+ 	gameOver _ paused _ false.
+ 	delay _ 500.
+ 	currentBlock _ nil.
+ 	self score: 0.
+ !

Item was added:
+ ----- Method: TetrisBoard>>numColumns (in category 'data') -----
+ numColumns
+ 
+ 	^10
+ 	!

Item was added:
+ ----- Method: TetrisBoard>>numRows (in category 'data') -----
+ numRows
+ 
+ 	^27
+ 	!

Item was added:
+ ----- Method: TetrisBoard>>originForCell: (in category 'as yet unclassified') -----
+ originForCell: aPoint
+ 
+ 	^aPoint - (1 at 1) * self cellSize + self position
+ 
+ !

Item was added:
+ ----- Method: TetrisBoard>>pause (in category 'button actions') -----
+ pause
+ 
+ 	gameOver ifTrue: [^ self].
+ 	paused _ paused not.
+ !

Item was added:
+ ----- Method: TetrisBoard>>rotateAntiClockWise (in category 'button actions') -----
+ rotateAntiClockWise
+ 
+ 	self running ifFalse: [^ self].
+ 	currentBlock moveDeltaX: 0 deltaY: 0 deltaAngle: -1.
+ !

Item was added:
+ ----- Method: TetrisBoard>>rotateClockWise (in category 'button actions') -----
+ rotateClockWise
+ 
+ 	self running ifFalse: [^ self].
+ 	currentBlock moveDeltaX: 0 deltaY: 0 deltaAngle: 1.
+ !

Item was added:
+ ----- Method: TetrisBoard>>running (in category 'button actions') -----
+ running
+ 
+ 	^currentBlock notNil and: [paused not]!

Item was added:
+ ----- Method: TetrisBoard>>score: (in category 'accessing') -----
+ score: aNumber
+ 
+ 	score _ aNumber.
+ 	game score: score.!

Item was added:
+ ----- Method: TetrisBoard>>step (in category 'stepping and presenter') -----
+ step
+ 
+ 	(self ownerThatIsA: HandMorph) ifNotNil: [^self].
+ 	paused ifTrue: [^ self]. 
+ 	currentBlock ifNil: [
+ 		currentBlock _ TetrisBlock new.
+ 		self addMorphFront: currentBlock.
+ 		currentBlock board: self.
+ 	] ifNotNil: [
+ 		currentBlock dropByOne ifFalse: [self storePieceOnBoard]
+ 	].
+ !

Item was added:
+ ----- Method: TetrisBoard>>stepTime (in category 'testing') -----
+ stepTime
+ 	^ delay!

Item was added:
+ ----- Method: TetrisBoard>>storePieceOnBoard (in category 'other') -----
+ storePieceOnBoard
+ 
+ 	currentBlock submorphs do: [ :each |
+ 		self addMorph: each.
+ 		((each top - self top) // self cellSize y) < 3 ifTrue: [
+ 			paused _ gameOver _ true.
+ 		].
+ 	].
+ 	currentBlock delete.
+ 	currentBlock _ nil.
+ 	self checkForFullRows.
+ 	self score: score + 10.
+ 	delay _ delay - 2 max: 80.
+ 
+ !

Item was added:
+ ----- Method: Text>>translated (in category '*Etoys-Squeakland-converting') -----
+ translated
+ 
+ 	^ string translated!

Item was added:
+ ----- Method: TextAlignment>>asPangoValueFrom:to: (in category '*Etoys-Squeakland-pango') -----
+ asPangoValueFrom: start to: end
+ 
+ 	^ Array with: #A with: start with: end with: alignment
+ !

Item was added:
+ TextAnchor subclass: #TextAnchorPlus
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-GeeMail'!

Item was added:
+ ----- Method: TextAnchorPlus>>emphasizeScanner: (in category 'as yet unclassified') -----
+ emphasizeScanner: scanner
+ 
+ 	anchoredMorph ifNil: [^self].
+ 	(anchoredMorph owner isKindOf: TextPlusPasteUpMorph) ifFalse: [^anchoredMorph _ nil].
+ 	"follwing has been removed - there was no implementation for it"
+ 	"scanner setYFor: anchoredMorph"
+ 
+ !

Item was added:
+ ----- Method: TextColor>>asPangoValueFrom:to: (in category '*Etoys-Squeakland-pango') -----
+ asPangoValueFrom: start to: end
+ 
+ 	^ Array with: #C with: start with: end with: color pixelValue32.
+ !

Item was added:
+ PluggableTextMorph subclass: #TextComponent
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Components'!

Item was added:
+ ----- Method: TextComponent>>initComponentIn: (in category 'components') -----
+ initComponentIn: aLayout
+ 	super initComponentIn: aLayout.
+ 	self setText: self getText!

Item was added:
+ ----- Method: TextComponent>>initFromPinSpecs (in category 'components') -----
+ initFromPinSpecs
+ 	| ioPin |
+ 	ioPin := pinSpecs first.
+ 	getTextSelector := ioPin isInput 
+ 		ifTrue: [ioPin modelReadSelector]
+ 		ifFalse: [nil].
+ 	setTextSelector := ioPin isOutput 
+ 				ifTrue: [ioPin modelWriteSelector]
+ 				ifFalse: [nil]!

Item was added:
+ ----- Method: TextComponent>>initPinSpecs (in category 'components') -----
+ initPinSpecs 
+ 	pinSpecs _ Array
+ 		with: (PinSpec new pinName: 'text' direction: #inputOutput
+ 				localReadSelector: nil localWriteSelector: nil
+ 				modelReadSelector: getTextSelector modelWriteSelector: setTextSelector
+ 				defaultValue: 'some text' pinLoc: 1.5)!

Item was added:
+ ----- Method: TextComponent>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	self extent: 144 @ 42!

Item was added:
+ ----- Method: TextDiffBuilder>>collectRunFrom:startingWith:into: (in category '*Etoys-Squeakland-creating patches') -----
+ collectRunFrom: todo startingWith: startIndex into: run
+ 	| next start |
+ 	start := startIndex.
+ 	self remove: start from: todo.
+ 	run add: (matches at: start).
+ 	"Search downwards"
+ 	next := start.
+ 	[next := next + (1 at 1).
+ 	todo includes: next] whileTrue:[
+ 		run addLast: (matches at: next).
+ 		self remove: next from: todo].
+ 	"Search upwards"
+ 	next := start.
+ 	[next := next - (1 at 1).
+ 	todo includes: next] whileTrue:[
+ 		run addFirst: (matches at: next).
+ 		self remove: next from: todo.
+ 		start := next. "To use the first index"
+ 	].
+ 	^start!

Item was added:
+ ----- Method: TextDiffBuilder>>detectShiftedRuns (in category '*Etoys-Squeakland-creating patches') -----
+ detectShiftedRuns
+ 	| sortedRuns lastY run shiftedRuns |
+ 	runs size < 2 ifTrue: [^ nil].
+ 	shiftedRuns _ OrderedCollection new.
+ 	sortedRuns _ SortedCollection sortBlock: [:a1 :a2 | a1 key x < a2 key x].
+ 	runs associationsDo: [:assoc | sortedRuns add: assoc].
+ 	lastY _ sortedRuns first key y.
+ 	2 to: sortedRuns size do:[:i | 
+ 		run _ sortedRuns at: i.
+ 		run key y > lastY
+ 			ifTrue: [lastY _ run key y]
+ 			ifFalse: [shiftedRuns add: run]].
+ 	^ shiftedRuns!

Item was added:
+ ----- Method: TextDiffBuilder>>generatePatchSequence (in category '*Etoys-Squeakland-creating patches') -----
+ generatePatchSequence
+ 	| ps |
+ 	ps := OrderedCollection new: srcLines size.
+ 	srcLines size timesRepeat:[ps add: nil].
+ 	self incorporateMatchesInto: ps.
+ 	self incorporateRemovalsInto: ps.
+ 	self incorporateAddsInto: ps.
+ 	^ps!

Item was added:
+ ----- Method: TextDiffBuilder>>hasMultipleMatches (in category '*Etoys-Squeakland-testing') -----
+ hasMultipleMatches
+ 	^multipleMatches == true!

Item was added:
+ ----- Method: TextDiffBuilder>>incorporateMatchesInto: (in category '*Etoys-Squeakland-creating patches') -----
+ incorporateMatchesInto: aPatchSequence
+ 	"Incorporate matches"
+ 	| index |
+ 	runs associationsDo:[:assoc|
+ 		index := assoc key y.
+ 		assoc value do:[:line|
+ 			self assert:[(aPatchSequence at: index) isNil].
+ 			aPatchSequence at: index put: (#match -> line).
+ 			index := index + 1.
+ 		].
+ 	].
+ !

Item was added:
+ ----- Method: TextDiffBuilder>>incorporateRemovalsInto: (in category '*Etoys-Squeakland-creating patches') -----
+ incorporateRemovalsInto: aPatchSequence
+ 	"Incorporate removals"
+ 	| index |
+ 	removed ifNil:[^self].
+ 	removed do:[:assoc|
+ 		index := assoc key.
+ 		self assert:[(aPatchSequence at: index) isNil].
+ 		aPatchSequence at: index put: #remove -> assoc value.
+ 	].
+ !

Item was added:
+ ----- Method: TextDiffBuilder>>processShiftedRuns (in category '*Etoys-Squeakland-creating patches') -----
+ processShiftedRuns
+ 	| key |
+ 	shifted isNil ifTrue:[^self].
+ 	shifted do:[:assoc|
+ 		key := assoc key.
+ 		assoc value doWithIndex:[:line :idx|
+ 			removed add: (key y + idx - 1) -> line.
+ 			added add: (key x + idx - 1) -> line].
+ 		runs removeKey: assoc key.
+ 	].
+ !

Item was added:
+ ----- Method: TextDiffBuilder>>splitCharacter (in category '*Etoys-Squeakland-private') -----
+ splitCharacter
+ 	^Character cr!

Item was added:
+ FormInput subclass: #TextInput
+ 	instanceVariableNames: 'name defaultValue textMorph'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Forms'!
+ 
+ !TextInput commentStamp: '<historical>' prior: 0!
+ a textual input; it takes text input straight from the user via a PluggableText!

Item was added:
+ ----- Method: TextInput class>>name:defaultValue:textMorph: (in category 'instance creation') -----
+ name: name0  defaultValue: defaultValue  textMorph: textMorph
+ 	^self new name: name0  defaultValue: defaultValue  textMorph: textMorph
+ 	!

Item was added:
+ ----- Method: TextInput>>name (in category 'input handling') -----
+ name
+ 	^name!

Item was added:
+ ----- Method: TextInput>>name:defaultValue:textMorph: (in category 'private-initialization') -----
+ name: name0  defaultValue: defaultValue0  textMorph: textMorph0
+ 	name _ name0.
+ 	defaultValue _ defaultValue0.
+ 	textMorph _ textMorph0.!

Item was added:
+ ----- Method: TextInput>>reset (in category 'nil') -----
+ reset
+ 	textMorph setText: defaultValue!

Item was added:
+ ----- Method: TextInput>>value (in category 'input handling') -----
+ value
+ 	textMorph hasUnacceptedEdits ifTrue: [ textMorph accept ].
+ 	^textMorph getText asString withInternetLineEndings!

Item was added:
+ ----- Method: TextLine>>justifiedPadFor: (in category '*Etoys-Squeakland-scanning') -----
+ justifiedPadFor: spaceIndex 
+ 	"Compute the width of pad for a given space in a line of justified text."
+ 
+ 	| pad |
+ 	internalSpaces = 0 ifTrue: [^0].
+ 	pad _ paddingWidth // internalSpaces.
+ 	spaceIndex <= (paddingWidth \\ internalSpaces)
+ 		ifTrue: [^pad + 1]
+ 		ifFalse: [^pad]!

Item was added:
+ ----- Method: TextLineInterval>>justifiedPadFor: (in category '*Etoys-Squeakland-scanning') -----
+ justifiedPadFor: spaceIndex 
+ 	"Compute the width of pad for a given space in a line of justified text."
+ 
+ 	| pad |
+ 	internalSpaces = 0 ifTrue: [^0].
+ 	pad _ paddingWidth // internalSpaces.
+ 	spaceIndex <= (paddingWidth \\ internalSpaces)
+ 		ifTrue: [^pad + 1]
+ 		ifFalse: [^pad]!

Item was changed:
  ----- Method: TextMorph class>>additionsToViewerCategories (in category '*eToys-scripting') -----
  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."
  
  	^ #(
- (#'color & border' (
- (slot backgroundColor 'The color of the background behind the text' Color readWrite Player getBackgroundColor Player setBackgroundColor:)))
  
+ (#'color' (
+ (slot color 'The color of the text' Color readWrite Player getTextColor Player setTextColor:)
- (text (
  (slot backgroundColor 'The color of the background behind the text' Color readWrite Player getBackgroundColor Player setBackgroundColor:)
+ ))
+ 
+ (text (
  (slot characters	'The characters in my contents' String	readWrite Player getCharacters Player setCharacters:)
  
+ (slot cursor 'The position among my characters that replacement text would go' Number readWrite Player getTextCursor Player setCursor:)
- (slot cursor 'The position among my characters that replacement text would go' Number readWrite Player getCursor Player setCursor:)
  (slot characterAtCursor 'The character at the my cursor position' String readWrite Player getCharacterAtCursor Player setCharacterAtCursor:)
  (slot count 'How many characters I have' Number readOnly Player getCount unused unused)
  
  (slot firstCharacter  'The first character in my contents' String  readWrite Player getFirstCharacter  Player  setFirstCharacter:)
  
  (slot lastCharacter  'The last character in my contents' String  readWrite Player getLastCharacter  Player  setLastCharacter:)
  (slot allButFirst 'All my characters except the first one' String readWrite Player getAllButFirstCharacter Player  setAllButFirstCharacter:)
  (command insertCharacters: 'insert the given string at my cursor position' String)
+ (command appendCharacters: 'append the given string' String)  
  (command insertContentsOf: 'insert the characters from another object at my cursor position' Player)
  (slot numericValue 'The number represented by my contents' Number readWrite Player getNumericValue Player  setNumericValue:)))
  
  (basic (
+ (slot characters	'The characters in my contents' String	readWrite Player getCharacters Player setCharacters:))))  
- (slot characters	'The characters in my contents' String	readWrite Player getCharacters Player setCharacters:))))
  
  
  !

Item was added:
+ ----- Method: TextMorph class>>nonwrappingPrototype (in category '*Etoys-Squeakland-scripting') -----
+ nonwrappingPrototype
+ 	"Answer the default-text-object de jour; at this time, it's actually an instance of UserText."
+ 
+ 	| text style index baseFont textMorph |
+ 	text := Text fromString: 'Text' translated.
+ 	baseFont _ Preferences standardEToysFont.
+ 	style _ baseFont textStyle ifNil: [Preferences standardDefaultTextFont textStyle].
+ 	index _ style fontIndexOfPointSize: 24.
+ 	style defaultFontIndex: index.
+ 	text addAttribute: (TextFontChange fontNumber: index).
+ 	textMorph := UserText new.
+ 	textMorph
+ 		contentsWrapped: text;
+ 		setTextStyle: style;
+ 		margins: 0 at 0.
+ 	"Too ugly dirty hack from boldAuthoringPrototype."
+ 	textMorph wrapFlag: false.
+ 	textMorph fit.
+ 	textMorph usePango ifTrue: [textMorph wrapFlag: true].
+ 	^ textMorph
+ 
+ "
+ TextMorph nonwrappingPrototype openInHand
+ "
+ !

Item was added:
+ ----- Method: TextMorph class>>usePango: (in category '*Etoys-Squeakland-class initialization') -----
+ usePango: aBoolean
+ 
+ 	self allSubInstancesDo: [:inst | inst usePango: aBoolean].
+ 	StringMorph allSubInstancesDo: [:inst | inst usePango: aBoolean].
+ !

Item was added:
+ ----- Method: TextMorph class>>usePangoChanged (in category '*Etoys-Squeakland-class initialization') -----
+ usePangoChanged
+ 	self usePango: Preferences usePangoRenderer.
+ 	DisplayScreen restoreDisplay.
+ !

Item was added:
+ ----- Method: TextMorph>>addFitAndWrapItemsTo: (in category '*Etoys-Squeakland-menus') -----
+ 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 specified.' translated.
+ 	aMenu 
+ 		addUpdating: #translatableString
+ 		target: self
+ 		action: #toggleTranslatable.
+ 	aMenu balloonTextForLastItem: 'When checked, contents will automatically be translated upon a locale change' translated.
+ 	aMenu addUpdating: #usePangoString target: self action: #toggleUsePango.
+ 
+ 	aMenu addLine.!

Item was added:
+ ----- Method: TextMorph>>addTextMenuItemsTo:event: (in category '*Etoys-Squeakland-menus') -----
+ addTextMenuItemsTo: aCustomMenu event: evt
+ 	"Add text-related items to a menu."
+ 
+ 	aCustomMenu addLine.
+ 	aCustomMenu add: 'font for entire text...' translated action: #promptForFont.
+ 
+ 	^ aCustomMenu!

Item was added:
+ ----- Method: TextMorph>>addTranslationItemsTo: (in category '*Etoys-Squeakland-localization') -----
+ addTranslationItemsTo: aMenu
+ 	| submenu |
+ 	(self hasProperty: #translations) ifFalse: [^self].
+ 
+ 	submenu := MenuMorph new defaultTarget: self.
+ 	self translations keysAndValuesDo: [:localeID :translation |	
+ 		submenu add: localeID asString, ': ', (translation asString contractTo: 30)
+ 			selector: #setLocale:
+ 			argument: localeID].
+ 	aMenu add: 'translations...' translated subMenu: submenu!

Item was added:
+ ----- Method: TextMorph>>appendCharacters: (in category '*Etoys-Squeakland-scripting access') -----
+ appendCharacters: aString
+ 	"append the characters from the given player to my end"
+ 
+ 	| end aText attributes |
+ 	end := text size.
+ 	aText := end = 0
+ 		ifTrue: [aString asText]
+ 		ifFalse: [
+ 			attributes := (text attributesAt: end)
+ 				select: [:attr | attr mayBeExtended].
+ 			Text string: aString attributes: attributes].
+ 	paragraph replaceFrom: end + 1 to: end with: aText displaying: true.
+ 	self updateFromParagraph   !

Item was added:
+ ----- Method: TextMorph>>changeColorSimply (in category '*Etoys-Squeakland-menu') -----
+ changeColorSimply
+ 	"Change the color of the receiver -- triggered, e.g. from a menu"
+ 
+ 	self changeTextColorSimply!

Item was added:
+ ----- Method: TextMorph>>changeTextColorSimply (in category '*Etoys-Squeakland-menu') -----
+ changeTextColorSimply
+ 	"Change the color of the receiver -- triggered, e.g. from a menu"
+ 
+ 	ColorPickerMorph new
+ 		choseModalityFromPreference;
+ 		sourceHand: self activeHand;
+ 		target: self;
+ 		selector: #selectionColor:;
+ 		originalColor: self textColor;
+ 		putUpFor: self near: self fullBoundsInWorld.
+ !

Item was added:
+ ----- Method: TextMorph>>crPassesFocus (in category '*Etoys-Squeakland-accessing') -----
+ crPassesFocus
+ ^self valueOfProperty: #crPassesFocus ifAbsent: [false]!

Item was added:
+ ----- Method: TextMorph>>crPassesFocus: (in category '*Etoys-Squeakland-accessing') -----
+ crPassesFocus: aBoolean
+ ^self setProperty: #crPassesFocus toValue: aBoolean
+ !

Item was added:
+ ----- Method: TextMorph>>highlightsOnFocus (in category '*Etoys-Squeakland-accessing') -----
+ highlightsOnFocus
+ "If this property is true, whenever the user clicks on the text it will show the focus change by changing its border color to red"
+ ^self valueOfProperty: #highlightsOnFocus ifAbsent: [false]
+ !

Item was added:
+ ----- Method: TextMorph>>highlightsOnFocus: (in category '*Etoys-Squeakland-accessing') -----
+ highlightsOnFocus: aBoolean
+ "See #highlightsOnFocus comment"
+ ^self setProperty: #highlightsOnFocus toValue: aBoolean
+ !

Item was added:
+ ----- Method: TextMorph>>mimeTypes (in category '*Etoys-Squeakland-drop outside') -----
+ mimeTypes
+ 	"Supported mime types for drag out.
+ 	TODO: UTF8_STRING is too Sugar specific. It should be generic name like text/plain"
+ 	^ #('UTF8_STRING')!

Item was added:
+ ----- Method: TextMorph>>openAppropriatePropertySheet (in category '*Etoys-Squeakland-property sheet') -----
+ openAppropriatePropertySheet
+ 	"Open a property-sheet of the sort appropriate to the receiver."
+ 
+ 	self openATextPropertySheet
+ 
+ 	
+ !

Item was added:
+ ----- Method: TextMorph>>promptForFont (in category '*Etoys-Squeakland-menu') -----
+ 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:!

Item was added:
+ ----- Method: TextMorph>>restoreText: (in category '*Etoys-Squeakland-accessing') -----
+ restoreText: newText 
+ 	"Restore text contents from property sheet, provided that string remains unchanged; if manual text editing of the receiver has taken place between launch of the property-sheet and the cancel-property-sheet request, those edits will be lost."
+ 
+ 	^ self newContents: newText deepCopy!

Item was added:
+ ----- Method: TextMorph>>selectionColor (in category '*Etoys-Squeakland-private') -----
+ selectionColor
+ 
+ 	| ind attrs c |
+ 	ind _ self editor startBlock stringIndex.
+ 	(ind isNil or: [ind < 1 or: [ind > text size]]) ifTrue: [ind _ 1].
+ 	attrs _ text attributesAt: ind.
+ 	c _ attrs detect: [:attr | attr class = TextColor] ifNone: [].
+ 	^ c ifNil: [Color black] ifNotNil: [c color].
+ 
+ !

Item was added:
+ ----- Method: TextMorph>>selectionColor: (in category '*Etoys-Squeakland-private') -----
+ selectionColor: aColor
+ 	"Set the color of the current selection.  If there is currently no selection, have the color apply to the entirety of the receiver's text."
+ 
+ 	| attribute int |
+ 	attribute _ TextColor color: aColor.
+ 	int _ self editor selectionInterval.
+ 	int size <= 0 ifTrue: [int _ 1 to: text size].
+ 	text addAttribute: attribute from: int first to: int last.
+ 	int size = text string size ifTrue:
+ 		[color _ aColor].
+ 	self changed.
+ !

Item was added:
+ ----- Method: TextMorph>>setLocale: (in category '*Etoys-Squeakland-localization') -----
+ setLocale: aLocaleID
+ 	"If there is a translation for aLoacalId, switch to it"
+ 
+ 	self translations at: aLocaleID ifPresent: [:translation|
+ 		self newContents: translation.
+ 		self setProperty: #locale toValue: aLocaleID].
+ !

Item was changed:
  ----- Method: TextMorph>>setNumericValue: (in category '*Etoys-support') -----
  setNumericValue: aValue
  	"Set the contents of the receiver to be a string obtained from aValue"
  
+ 	aValue isInteger ifTrue: [
+ 		^ self newContents: aValue asString
+ 	].
+ 	aValue isNumber ifTrue: [
+ 		^ self newContents: (aValue asFloat roundTo: (self defaultFloatPrecisionFor: #getNumericValue)) asString.
+ 	].
+ 	^ self newContents: '0'.
+ !
- 	self newContents: aValue asString!

Item was added:
+ ----- Method: TextMorph>>toggleTranslatable (in category '*Etoys-Squeakland-localization') -----
+ toggleTranslatable
+ 	"Toggle whether the receiver's contents should be translated automatically upon a locale change."
+ 
+ 	self translatable: self translatable not!

Item was added:
+ ----- Method: TextMorph>>translatable (in category '*Etoys-Squeakland-localization') -----
+ translatable
+ 	"Answer whether the contents of the receiver should automaticaly be translated upon language switch."
+ 
+ 	^ self hasProperty: #translatable!

Item was added:
+ ----- Method: TextMorph>>translatable: (in category '*Etoys-Squeakland-localization') -----
+ translatable: aBoolean
+ 	"Set the receiver's translatable property as indicated"
+ 
+ 	self translatable
+ 		ifTrue:
+ 			[self removeProperty: #translatable]
+ 		ifFalse:
+ 			[self setProperty: #translatable toValue: true]!

Item was added:
+ ----- Method: TextMorph>>translatableString (in category '*Etoys-Squeakland-localization') -----
+ translatableString
+ 	"Answer a string characterizing whether or not I am translatable"
+ 
+ 	^ (self translatable ifTrue: ['<yes>'] ifFalse: ['<no>']), 'translatable' translated!

Item was added:
+ ----- Method: TextMorph>>translations (in category '*Etoys-Squeakland-localization') -----
+ translations
+ 	^self valueOfProperty: #translations ifAbsentPut: [Dictionary new]!

Item was added:
+ ----- Method: TextMorph>>usePango (in category '*Etoys-support') -----
+ usePango
+ 	^ self
+ 		valueOfProperty: #usePango
+ 		ifAbsent: [false]!

Item was added:
+ ----- Method: TextMorph>>usePango: (in category '*Etoys-support') -----
+ usePango: aBoolean
+ 	^ self
+ 		setProperty: #usePango
+ 		toValue: aBoolean!

Item was added:
+ ----- Method: TextMorphEditor>>select (in category '*Etoys-Squeakland-current selection') -----
+ select
+ 	"Ignore selection redraw requests."!

Item was added:
+ ----- Method: TextMorphEditor>>selectionInterval: (in category '*Etoys-Squeakland-private') -----
+ selectionInterval: anInterval
+ 	"Make my selection span the indicated interval.  If the interval extends outside the range of characters of the current text, force it within."
+ 
+ 	| mySize |
+ 	mySize := paragraph text string size.
+ 	self selectFrom: (anInterval start min: mySize)
+ 		to:	(anInterval stop min: mySize)!

Item was added:
+ ----- Method: TextPropertiesMorph>>applyToWholeText: (in category '*Etoys-Squeakland-accessing') -----
+ applyToWholeText: anObject
+ 	"Set the value of applyToWholeText"
+ 
+ 	applyToWholeText _ anObject!

Item was changed:
+ ----- Method: TextPropertiesMorph>>changeSelectionAttributeTo: (in category 'button actions') -----
- ----- Method: TextPropertiesMorph>>changeSelectionAttributeTo: (in category 'as yet unclassified') -----
  changeSelectionAttributeTo: newAttribute
+ 	"Install an attribute into the canonical selection."
  
+ 	| activeEditor |
+ 	self establishSelectionInterval.
+ 
+ 	activeEditor := self activeTextMorph editor.
+ 	activeEditor replaceSelectionWith:
+ 		(activeEditor selection asText addAttribute: newAttribute).
+ 	self activeTextMorph updateFromParagraph.
+ 	self activeTextMorph releaseEditor!
- 	self applyToWholeText ifTrue: [self activeEditor selectAll].
- 	self activeEditor replaceSelectionWith: (
- 		self activeEditor selection asText addAttribute: newAttribute
- 	).
- 	self activeTextMorph updateFromParagraph.!

Item was changed:
+ ----- Method: TextPropertiesMorph>>changeStyle (in category 'button actions') -----
- ----- Method: TextPropertiesMorph>>changeStyle (in category 'as yet unclassified') -----
  changeStyle
+ 	"Put up a menu allowing the user to choose a new style for the TextMorph."
  
  	| aList reply style |
+ 	aList _ StrikeFont actualFamilyNames.
- 
- 	aList := StrikeFont actualFamilyNames.
  	aList addFirst: 'DefaultTextStyle'.
+ 	reply _ (SelectionMenu labelList: aList lines: #(1) selections: aList) startUp.
- 	reply := UIManager default chooseFrom: aList values: aList lines: #(1).
  	reply ifNil: [^self].
  
+ 	(style _ TextStyle named: reply) ifNil: [Beeper beep. ^ true].
- 	(style := TextStyle named: reply) ifNil: [Beeper beep. ^ true].
  	self applyToWholeText ifTrue: [self activeEditor selectAll].
  	self activeEditor changeStyleTo: style copy.
+ 	self activeTextMorph updateFromParagraph.
+ 	self activeTextMorph releaseEditor!
- 	self activeTextMorph updateFromParagraph.!

Item was changed:
+ ----- Method: TextPropertiesMorph>>changeTargetColorTo: (in category 'button actions') -----
- ----- Method: TextPropertiesMorph>>changeTargetColorTo: (in category 'as yet unclassified') -----
  changeTargetColorTo: aColor
+ 	"Change the selection's target to be of the given color."
  
+ 	self establishSelectionInterval.
+ 	self activeTextMorph selectionColor:  aColor.
+ 	self activeTextMorph releaseEditor!
- 	self applyToWholeText ifTrue: [
- 		lastGlobalColor := aColor
- 	].
- 	self changeSelectionAttributeTo: (TextColor color: aColor)!

Item was added:
+ ----- Method: TextPropertiesMorph>>establishSelectionInterval (in category '*Etoys-Squeakland-button actions') -----
+ establishSelectionInterval
+ 	"If the active editor has a nonempty selection interval, assimilate it."
+ 
+ 	| activeEditor anInterval itsSize |
+ 	activeEditor := self activeEditor.
+ 	anInterval := activeEditor selectionInterval.
+ 	anInterval size > 0
+ 		ifTrue:  "User set it manually, so remember it"
+ 			[selectionInterval := anInterval]
+ 		ifFalse:
+ 			[itsSize := self activeTextMorph text string size.
+ 			selectionInterval := Interval from: selectionInterval start to: (selectionInterval stop min: itsSize).
+ 			activeEditor selectionInterval:  selectionInterval]!

Item was changed:
  ----- Method: TextPropertiesMorph>>initialize (in category 'initialization') -----
  initialize
  	"initialize the state of the receiver"
+ 
  	super initialize.
+ 
+ 	applyToWholeText _ false. 
- 	""
- 	applyToWholeText := true.
  	myTarget
+ 		ifNil:
+ 			[myTarget _ TextMorph new openInWorld.
- 		ifNil: [""
- 			myTarget := TextMorph new openInWorld.
  			myTarget contents: ''].
  
+ 	activeTextMorph _ myTarget.  "Formerly was a copy..."
+ 
+ 	thingsToRevert _ OrderedCollection new.  "to control order of execution"
- 	activeTextMorph := myTarget copy.
- 	activeTextMorph extent: 300 @ 100;	 
- 			 releaseCachedState.
  	thingsToRevert
+ 		add: (#wrapFlag: ->  myTarget isWrapped);
+ 		add: (#autoFit: ->  myTarget isAutoFit);
+ 		add: (#setTextStyle: -> myTarget textStyle);
+ 		add: (#margins: ->  myTarget margins);
+ 		add: (#extent: ->  myTarget extent);
+ 		add: (#textColor: ->  myTarget textColor);
+ 		add: (#restoreText: ->  myTarget text deepCopy).
- 		at: #wrapFlag: put: myTarget isWrapped;
- 		 at: #autoFit: put: myTarget isAutoFit;
- 		 at: #margins: put: myTarget margins;
- 		at: #extent: put: myTarget extent.
  	self rebuild!

Item was changed:
+ ----- Method: TextPropertiesMorph>>offerFontMenu (in category 'button actions') -----
- ----- Method: TextPropertiesMorph>>offerFontMenu (in category 'as yet unclassified') -----
  offerFontMenu
  	"Present a menu of available fonts, and if one is chosen, apply it to the current selection.  
  	Use only names of Fonts of this paragraph  "
  
  	| aList reply |
+ 	self establishSelectionInterval.
+ 	aList _ self activeTextMorph textStyle fontNamesWithPointSizes.
+ 	reply _ (SelectionMenu labelList: aList selections: aList) startUp.
- 
- 	aList := self activeTextMorph textStyle fontNamesWithPointSizes.
- 	reply := UIManager default chooseFrom: aList values: aList.
  	reply ifNil: [^self].
+ 	self establishSelectionInterval.  "This really does need to be called again!!"
- 	self applyToWholeText ifTrue: [self activeEditor selectAll].
  	self activeEditor replaceSelectionWith:
  		(Text string: self activeEditor selection asString 
  			attribute: (TextFontChange fontNumber: (aList indexOf: reply))).
+ 	self activeTextMorph updateFromParagraph.
+ 	self activeTextMorph releaseEditor!
- 	self activeTextMorph updateFromParagraph.!

Item was added:
+ ----- Method: TextPropertiesMorph>>selectionInterval (in category '*Etoys-Squeakland-accessing') -----
+ selectionInterval
+ 	"Answer the value of selectionInterval"
+ 
+ 	^ selectionInterval!

Item was added:
+ ----- Method: TextPropertiesMorph>>selectionInterval: (in category '*Etoys-Squeakland-accessing') -----
+ selectionInterval: anObject
+ 	"Set the value of selectionInterval"
+ 
+ 	selectionInterval _ anObject!

Item was changed:
+ ----- Method: TextPropertiesMorph>>toggleSelectionAttribute: (in category 'button actions') -----
- ----- Method: TextPropertiesMorph>>toggleSelectionAttribute: (in category 'as yet unclassified') -----
  toggleSelectionAttribute: newAttribute
+ 	"Toggle the given text-attribute  for the current text selection."
  
  	| selText oldAttributes |
+ 	self establishSelectionInterval.
+ 	self activeEditor selectFrom:  selectionInterval start to: selectionInterval stop.
  
+ 	selText _ self activeEditor selection asText.
+ 	oldAttributes _ selText attributesAt: 1 forStyle: self activeTextMorph textStyle.
- 	self applyToWholeText ifTrue: [self activeEditor selectAll].
- 	selText := self activeEditor selection asText.
- 	oldAttributes := selText attributesAt: 1 forStyle: self activeTextMorph textStyle.
  	oldAttributes do: [:att |
  		(att dominates: newAttribute) ifTrue: [newAttribute turnOff]
  	].
  	self activeEditor replaceSelectionWith: (selText addAttribute: newAttribute).
+ 	self activeTextMorph updateFromParagraph.
+ 	self activeTextMorph releaseEditor!
- 	self activeTextMorph updateFromParagraph.!

Item was added:
+ ----- Method: TextStyle class>>addNewStyle: (in category '*Etoys-Squeakland-instance creation') -----
+ addNewStyle: args
+ 
+ 	| newName f newStyle newSize |
+ 	newName := FillInTheBlank request: 'new font name' translated initialAnswer: 'Times New Roman'.
+ 	newName ifEmpty: [^ nil].
+ 	(TextStyle actualTextStyles keys includes: newName asSymbol) ifTrue: [
+ 		^ nil
+ 	].
+ 	newSize := FillInTheBlank request: 'new size' translated initialAnswer: '18'.
+ 	newSize := newSize asNumber.
+ 	newSize < 1 ifTrue: [^ nil].
+ 	
+ 	f := StandInFont new familyName: newName pointSize: newSize emphasized: 0.
+ 	newStyle := self fontArray: (Array with: f).
+ 	TextConstants at: newName put: newStyle.
+ 	args second modalSelection: {newName. newSize}.
+ !

Item was added:
+ ----- Method: TextStyle>>equals: (in category '*Etoys-Squeakland-comparing') -----
+ equals: other
+ 
+ 	self species == other species ifFalse: [^ false].
+ 	1 to: self class instSize do:
+ 		[:i | (self instVarAt: i) = (other instVarAt: i) ifFalse: [^ false]].
+ 	^ true!

Item was added:
+ AlignmentMorph subclass: #TextualEventSequenceDisplayer
+ 	instanceVariableNames: 'mouseEventSequenceMorph'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !TextualEventSequenceDisplayer commentStamp: 'sw 12/24/2006 04:31' prior: 0!
+ A tool that displays the events comprising a mouse-event-sequence in a scrolling textual list.  This is not an editor, not yet anyway...  Consider it a tantalizing loose end at the moment.!

Item was added:
+ ----- Method: TextualEventSequenceDisplayer>>mouseEventSequenceMorph: (in category 'initialization') -----
+ mouseEventSequenceMorph: aMorph
+ 	"Set the mouseEventSequenceMorph, and hence build the receiver."
+ 
+ 	| aString ptm |
+ 	mouseEventSequenceMorph := aMorph.
+ 	self hResizing: #shrinkWrap.
+ 	self vResizing: #shrinkWrap.
+ 	aString := String streamContents:
+ 		[:aStream | 
+ 			aMorph events do:
+ 				[:evt | aStream nextPutAll: evt printString.  aStream cr]].
+ 
+ 	ptm := PluggableTextMorph new.
+ 	ptm borderWidth: 2.
+ 	ptm extent: 400 @ 100.
+ 	ptm setBalloonText: 'Each line represents an event in the event sequence I represent' translated.
+ 	ptm color: (Color r: 0.806 g: 1.0 b: 1.0).
+ 	ptm editString: aString.
+ 	ptm retractable: false; scrollBarOnLeft: false.
+ 	ptm borderWidth: 2.
+ 	ptm borderColor: ptm color muchDarker; cornerStyle: #rounded.
+ 	
+ 	self addMorphCentered: ptm!

Item was added:
+ ----- Method: TextualEventSequenceDisplayer>>setExtentFromHalo: (in category 'resizing') -----
+ setExtentFromHalo: anExtent
+ 	"The user has dragged the grow box such that the receiver's extent would be anExtent.  Do what's needed."
+ 
+ 	submorphs first setExtentFromHalo: anExtent!

Item was added:
+ ----- Method: TextualEventSequenceDisplayer>>wantsToBeDroppedInto: (in category 'drag and drop') -----
+ wantsToBeDroppedInto: aMorph
+ 	"Return true if it's okay to drop the receiver into a prospective recipient."
+ 
+ 	^ aMorph isWorldMorph "only into worlds"!

Item was added:
+ ----- Method: TheWorldMenu class>>registerStandardInternetApps (in category '*Etoys-Squeakland-open-menu registry') -----
+ registerStandardInternetApps
+ 	"Register the three currently-built-in internet apps and the hook for SqueakMap with the open-menu registry. This is a one-time initialization affair, contending with the fact that the three apps are already in the image."
+ 
+ 	self registerOpenCommand: 
+ 		{ 'Package Loader' translated. { TheWorldMenu . #openPackageLoader }. 'A tool that lets you browse and load packages from SqueakMap, an index of Squeak code available on the internet' translated}.
+ 
+ 	#(Scamper Celeste IRCConnection) do:
+ 		[:sym |
+ 			(Smalltalk at: sym ifAbsent: [nil]) ifNotNilDo:
+ 				[:aClass | aClass registerInOpenMenu]]
+ 
+ "
+ OpenMenuRegistry _ nil.
+ TheWorldMenu registerStandardInternetApps.
+ "!

Item was added:
+ ----- Method: TheWorldMenu>>buildShowSourceMenu (in category '*Etoys-Squeakland-construction') -----
+ buildShowSourceMenu
+ 	"Build the menu that is put up when the show-source button is hit."
+ 
+ 	| menu |
+ 	menu _ MenuMorph new defaultTarget: self.
+ 	menu commandKeyHandler: self.
+ 	self colorForDebugging: menu.
+ 	menu addStayUpItem.
+ 
+ 	self fillIn: menu from: { 
+ 		{'open...' translatedNoop. { self  . #openWindow } }.
+ 		{'windows...' translatedNoop. { self  . #windowsDo } }.
+ 		{'changes...' translatedNoop. { self  . #changesDo } }}.
+ 	self fillIn: menu from: { 
+ 		{'help...' translatedNoop. { self  . #helpDo }.  'puts up a menu of useful items for updating the system, determining what version you are running, and much else' translatedNoop}.
+ 		{'appearance...' translatedNoop. { self  . #appearanceDo }. 'put up a menu offering many controls over appearance.' translatedNoop}}.
+ 
+ 	self fillIn: menu from: {
+ 			{'do...' translatedNoop. { Utilities . #offerCommonRequests} . 'put up an editible list of convenient expressions, and evaluate the one selected.' translatedNoop}}.
+ 
+ 	self fillIn: menu from: { 
+ 		nil.
+ 		{'objects (o)' translatedNoop. { #myWorld . #activateObjectsTool } . 'A tool for finding and obtaining many kinds of objects' translatedNoop}.
+ 		{'new morph...' translatedNoop. { self  . #newMorph }. 'Offers a variety of ways to create new objects' translatedNoop}.
+ 		nil.
+ 		{'authoring tools...' translatedNoop. { self  . #scriptingDo } . 'A menu of choices useful for authoring' translatedNoop}.
+ 		{'playfield options...' translatedNoop. { self  . #playfieldDo } . 'A menu of options pertaining to this object as viewed as a playfield' translatedNoop}.
+ 		{'flaps...' translatedNoop. { self . #flapsDo } . 'A menu relating to use of flaps.  For best results, use "keep this menu up"' translatedNoop}.
+ 		{'projects...' translatedNoop. { self  . #projectDo }. 'A menu of commands relating to use of projects' translatedNoop}.
+ 		{'debug...' translatedNoop. { self  . #debugDo } . 'a menu of debugging items' translatedNoop}.
+ 		nil.
+ 		{'edit this menu' translatedNoop.  { self . #editShowSourceMenu } . 'open a code editor on the method that defines this menu' translatedNoop}}.
+ 
+ 	^ menu!

Item was added:
+ ----- Method: TheWorldMenu>>editShowSourceMenu (in category '*Etoys-Squeakland-as yet unclassified') -----
+ editShowSourceMenu
+ 	"Invoked from menu, opens up a single-msg browser on the method that defines the show-source menu."
+ 
+ 	| mr |
+ 	mr _ MethodReference new setStandardClass: TheWorldMenu  methodSymbol: #buildShowSourceMenu.
+ 	self systemNavigation browseMessageList: {mr} name: 'show-source menu' translated autoSelect: nil!

Item was added:
+ ----- Method: TheWorldMenu>>fullScriptingMenu (in category '*Etoys-Squeakland-Etoys') -----
+ fullScriptingMenu
+ 	"Build the authoring-tools menu for the world.  This method offeres all the item historically offered in the full etoy system; when eToyFriendly is on, most of the items are suppressed."
+ 
+ 	^ self fillIn: (self menu: 'authoring tools...' translatedNoop) from: { 
+ 		{ 'objects (o)' translatedNoop. { #myWorld . #activateObjectsTool }. 'A searchable source of new objects.' translatedNoop}.
+ 		nil.  "----------"
+  		{ 'view trash contents' translatedNoop. { #myWorld . #openScrapsBook:}. 'The place where all your trashed morphs go.' translatedNoop}.
+  		{ 'empty trash can' translatedNoop. { Utilities . #emptyScrapsBookGC}. 'Empty out all the morphs that have accumulated in the trash can.' translatedNoop}.
+ 		nil.  "----------"	
+ 
+ 		{ 'sound library' translatedNoop.  { SoundLibraryTool.  #newInHand}.'A tool that lets you see and manage all the sounds in the sound library' translatedNoop}.
+ 	{ 'new scripting area' translatedNoop. { #myWorld . #detachableScriptingSpace}. 'A window set up for simple scripting.' translatedNoop}.
+ 
+ 		nil.  "----------"		
+ 	
+ 		{ 'status of scripts' translatedNoop. {#myWorld . #showStatusOfAllScripts}. 'Lets you view the status of all the scripts belonging to all the scripted objects of the project.' translatedNoop}.
+ 		{ 'summary of scripts' translatedNoop. {#myWorld . #printScriptSummary}. 'Produces a summary of scripted objects in the project, and all of their scripts.' translatedNoop}.
+ 		{ 'browser for scripts' translatedNoop. {#myWorld . #browseAllScriptsTextually}. 'Allows you to view all the scripts in the project in a traditional programmers'' "browser" format' translatedNoop}.
+ 
+ 
+ 		nil.
+ 
+ 		{ 'gallery of players' translatedNoop. {#myWorld . #galleryOfPlayers}. 'A tool that lets you find out about all the players used in this project' translatedNoop}.
+ 
+ "		{ 'gallery of scripts' translated. {#myWorld . #galleryOfScripts}. 'Allows you to view all the scripts in the project' translated}."
+ 
+ 		{ 'etoy vocabulary summary' translatedNoop. {#myWorld . #printVocabularySummary }. 'Displays a summary of all the pre-defined commands and properties in the pre-defined EToy vocabulary.' translatedNoop}.
+ 
+ 		{ 'attempt misc repairs' translatedNoop. {#myWorld . #attemptCleanup}. 'Take measures that may help fix up some things about a faulty or problematical project.' translatedNoop}.
+ 
+ 		{ 'remove all viewers' translatedNoop. {#myWorld . #removeAllViewers}. 'Remove all the Viewers from this project.' translatedNoop}.
+ 
+ 		{ 'abandon unsituated players' translatedNoop.  {#myWorld. #abandonUnsituatedPlayers}. 'If any objects in the project have references, in player-valued variables, to other objects otherwise not present in the project, abandon them and replace former references to them by references to Dot'}.
+ 
+ 		{ 'refer to masters' translatedNoop. {#myWorld . #makeAllScriptEditorsReferToMasters }. 'Ensure that all script editors are referring to the first (alphabetically by external name) Player of their type' translatedNoop}.
+ 
+ 		nil.  "----------" 
+ 
+ 		{ 'unlock locked objects' translatedNoop. { #myWorld . #unlockContents}. 'If any items on the world desktop are currently locked, unlock them.' translatedNoop}.
+ 		{ 'unhide hidden objects' translatedNoop. { #myWorld . #showHiders}. 'If any items on the world desktop are currently hidden, make them visible.' translatedNoop}.
+         }!

Item was added:
+ ----- Method: TheWorldMenu>>offerScalingMenu (in category '*Etoys-Squeakland-menu') -----
+ offerScalingMenu
+ 	"Put up the sugar-navigator's scaling / display-mode ) menu."
+ 
+ 	| aBar |
+ 	aBar := SugarNavigatorBar current ifNil: [SugarNavigatorBar new].
+ 	aBar chooseScreenSetting
+ 
+ 	!

Item was added:
+ ----- Method: ThreePhaseButtonMorph class>>blackTriangularOpener (in category '*Etoys-Squeakland-instance creation') -----
+ blackTriangularOpener
+ 	"Answer a button pre-initialized with black triangular images images."
+ 
+ 	| f |
+ 	^ self new
+ 		onImage: (f _ ScriptingSystem formAtKey: 'RightCaret');
+ 		pressedImage: (ScriptingSystem formAtKey: 'DownCaret');
+ 		offImage: (ScriptingSystem formAtKey: 'DownCaret');
+ 		extent: f extent + (2 at 0);
+ 		yourself
+ !

Item was added:
+ ----- Method: ThreePhaseButtonMorph class>>labelSymbol: (in category '*Etoys-Squeakland-instance creation') -----
+ labelSymbol: aSymbol 
+ 	"(self labelSymbol: #TryIt) openInHand"
+ 	| aButton form |
+ 	aButton := ThreePhaseButtonMorph new.
+ 	form := ScriptingSystem formAtKey: aSymbol.
+ 	aButton offImage: form.
+ 	aButton image: form.
+ 	aButton
+ 		pressedImage: (ScriptingSystem formPressedAtKey: aSymbol).
+ 	^ aButton!

Item was added:
+ ----- Method: ThreePhaseButtonMorph class>>labelSymbol:target:actionSelector:arguments: (in category '*Etoys-Squeakland-instance creation') -----
+ labelSymbol: aSymbol target: anObject actionSelector: selector arguments: anArray 
+ 	| aButton |
+ 	aButton := self labelSymbol: aSymbol.
+ 	aButton target: anObject.
+ 	aButton actionSelector: selector.
+ 	aButton arguments: anArray.
+ 	^ aButton!

Item was added:
+ ----- Method: ThreePhaseButtonMorph>>isButton (in category '*Etoys-Squeakland-testing') -----
+ isButton
+ 
+ 	^ true.
+ !

Item was added:
+ ----- Method: Thumbnail>>originalForm (in category '*Etoys-Squeakland-accessing') -----
+ originalForm
+ 
+ 	^ originalForm
+ !

Item was added:
+ TileMorph subclass: #TileCommandWithArgumentMorph
+ 	instanceVariableNames: 'playerTile stringName'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-EToys-Kedama'!

Item was added:
+ ----- Method: TileCommandWithArgumentMorph class>>newKedamaAngleToTile (in category 'as yet unclassified') -----
+ newKedamaAngleToTile
+ 
+ 	^ (self new)
+ 		operatorOrExpression: #getAngleTo:; 
+ 		stringName: 'angleTo';
+ 		type: #Player
+ 		yourself.
+ 
+ !

Item was added:
+ ----- Method: TileCommandWithArgumentMorph class>>newKedamaBounceOnTile (in category 'as yet unclassified') -----
+ newKedamaBounceOnTile
+ 
+ 	^ (self new)
+ 		operatorOrExpression: #bounceOn:; 
+ 		stringName: 'bounceOn';
+ 		type: #Player
+ 		yourself.
+ 
+ !

Item was added:
+ ----- Method: TileCommandWithArgumentMorph class>>newKedamaDistanceToTile (in category 'as yet unclassified') -----
+ newKedamaDistanceToTile
+ 
+ 	^ (self new)
+ 		operatorOrExpression: #getDistanceTo:; 
+ 		stringName: 'distanceTo';
+ 		type: #Player
+ 		yourself.
+ 
+ !

Item was added:
+ ----- Method: TileCommandWithArgumentMorph class>>newKedamaGetPatchValueTile (in category 'as yet unclassified') -----
+ newKedamaGetPatchValueTile
+ 
+ 	^ (self new)
+ 		operatorOrExpression: #getPatchValueIn:; 
+ 		stringName: 'patchValueIn';
+ 		type: #Patch;
+ 		yourself.
+ 
+ !

Item was added:
+ ----- Method: TileCommandWithArgumentMorph class>>newKedamaGetTurtleOfTile (in category 'as yet unclassified') -----
+ newKedamaGetTurtleOfTile
+ 
+ 	^ (self new)
+ 		operatorOrExpression: #getTurtleOf:; 
+ 		stringName: 'turtleOf';
+ 		type: #Player
+ 		yourself.
+ !

Item was added:
+ ----- Method: TileCommandWithArgumentMorph class>>newKedamaGetUpHillTile (in category 'as yet unclassified') -----
+ newKedamaGetUpHillTile
+ 
+ 	^ (self new)
+ 		operatorOrExpression: #getUphillIn:; 
+ 		stringName: 'upHillIn';
+ 		type: #Patch
+ 		yourself.
+ !

Item was added:
+ ----- Method: TileCommandWithArgumentMorph>>addTile (in category 'all') -----
+ addTile
+ 
+ 	| m1 desiredW m2 label |
+ 	self removeAllMorphs.
+ 	m1 _ TilePadMorph new.
+ 	label _ 	StringMorph contents: stringName translated font: ScriptingSystem fontForTiles.
+ 
+ 	m2 _ TileMorph new.
+ 	m2 extent: 20 at 22.
+ 	m2 minWidth: 20.
+ 	m1 extent: (m2 extent + (2 at 2)).
+ 	m1 setType: #Player.
+ 	m1 addMorph: m2.
+ 	desiredW _ m1 width.
+ 	self extent: (desiredW max: self basicWidth) @ self class defaultH.
+ 	m1 position: (bounds center x - (m1 width // 2)) @ (bounds top + 1).
+ 	self addMorphBack: m1.
+ 	self addMorphFront: label.
+ 	playerTile _ m1.
+ !

Item was added:
+ ----- Method: TileCommandWithArgumentMorph>>initialize (in category 'all') -----
+ initialize
+ 
+ 	super initialize.
+ 	type _ #Player.
+ 	operatorOrExpression _ #getDistanceTo:.
+ 	stringName _ 'distance to'.
+ 	self addTile.
+ !

Item was added:
+ ----- Method: TileCommandWithArgumentMorph>>line1: (in category 'all') -----
+ line1: line1
+ 
+ 	| label |
+ 	self removeAllMorphs.
+ 
+ 	label _ 	StringMorph contents: stringName translated font: ScriptingSystem fontForTiles.
+ 
+ 	self addMorphBack: label.
+ 	self addMorphBack: playerTile.
+ !

Item was added:
+ ----- Method: TileCommandWithArgumentMorph>>operatorOrExpression: (in category 'all') -----
+ operatorOrExpression: aSymbol
+ 
+ 	operatorOrExpression _ aSymbol.
+ !

Item was added:
+ ----- Method: TileCommandWithArgumentMorph>>parseNodeWith: (in category 'all') -----
+ parseNodeWith: encoder
+ 	"We have a hidden arg. Output two keywords with interspersed arguments."
+ 	^ playerTile parseNodeWith: encoder!

Item was added:
+ ----- Method: TileCommandWithArgumentMorph>>setArgumentDefaultTo: (in category 'all') -----
+ setArgumentDefaultTo: aPlayer
+ 
+ 	playerTile submorphs first setToReferTo: aPlayer.
+ 	(aPlayer costume renderedMorph isMemberOf: KedamaPatchMorph)
+ 		ifTrue: [playerTile setType: #Patch]!

Item was added:
+ ----- Method: TileCommandWithArgumentMorph>>sexpWith: (in category 'all') -----
+ sexpWith: aDictionary
+ 
+ 	^ playerTile sexpWith: aDictionary.
+ !

Item was added:
+ ----- Method: TileCommandWithArgumentMorph>>storeCodeOn:indent: (in category 'all') -----
+ storeCodeOn: aStream indent: tabCount 
+ 	"We have a hidden arg. Output two keywords with interspersed arguments."
+ 
+ 	| parts |
+ 	parts := operatorOrExpression keywords.
+ 	aStream nextPutAll: parts first.
+ 	aStream space.
+ 	playerTile storeCodeOn: aStream indent: tabCount.
+ !

Item was added:
+ ----- Method: TileCommandWithArgumentMorph>>stringName: (in category 'all') -----
+ stringName: aString
+ 
+ 	stringName _ aString.
+ !

Item was added:
+ ----- Method: TileCommandWithArgumentMorph>>type: (in category 'all') -----
+ type: aSymbol
+ 
+ 	type _ aSymbol.
+ !

Item was changed:
  ----- Method: TileLikeMorph>>localeChanged (in category 'initialization') -----
  localeChanged
  	"Update myself to reflect the change in locale"
  
+ 	self updateWordingToMatchVocabulary.
+ 	self fullBounds.
+ !
- 	self updateWordingToMatchVocabulary!

Item was added:
+ ----- Method: TileLikeMorph>>nextTile (in category '*Etoys-Squeakland-etoys-debugger') -----
+ nextTile
+ 	^ (self ownerThatIsA: ScriptEditorMorph)
+ 		nextTileTo: self!

Item was changed:
  RectangleMorph subclass: #TileMorph
  	instanceVariableNames: 'type slotName literal operatorOrExpression actualObject downArrow upArrow suffixArrow typeColor lastArrowTick nArrowTicks operatorReadoutString possessive retractArrow vocabulary vocabularySymbol'
+ 	classVariableNames: 'DownPicture EqualityOperators RetractPicture SuffixArrowAllowance SuffixPicture UpArrowAllowance UpdatingOperators UpPicture'
- 	classVariableNames: 'DownPicture RetractPicture SuffixArrowAllowance SuffixPicture UpArrowAllowance UpPicture UpdatingOperators'
  	poolDictionaries: ''
  	category: 'Etoys-Scripting Tiles'!
  
  !TileMorph commentStamp: '<historical>' prior: 0!
  A tile with up, down and suffix arrows.
  
  To install new Forms for the arrows, just nil out UpPicture, DownPicture,
  or SuffixPicture.
  Create actors with the picture you want and write it out with these file names:
  'tile inc arrow.morph' 'tile dec arrow.morph' 'tile suffix
  arrow.morph'.  Make sure that file is in the same directory as the image.
  Open an EToy.!

Item was added:
+ ----- Method: TileMorph class>>addArrowsOn: (in category '*Etoys-Squeakland-utilities') -----
+ addArrowsOn: aMorph
+ 	"add arrows on a morph, and answer {upArrow. downArrow}"
+ 	| downArrow upArrow holder |
+ 	downArrow _ ImageMorph new image: TileMorph downPicture.
+ 	upArrow _ ImageMorph new image: TileMorph upPicture.
+ 	holder _ Morph new extent: downArrow width @ (upArrow height + downArrow height + 1).
+ 	holder beTransparent.
+ 	upArrow position: holder topLeft.
+ 	downArrow position: upArrow left @ (upArrow bottom + 1).
+ 	holder addMorph: upArrow.
+ 	holder addMorph: downArrow.
+ 	holder setProperty: #arrows toValue: true.
+ 	holder clipSubmorphs: true.
+ 	aMorph addMorphFront: holder.
+ 	^ Array with: upArrow with: downArrow!

Item was changed:
  ----- Method: TileMorph class>>defaultH (in category 'constants') -----
  defaultH
+ 	"Answer minimal size of tile height. This number is decided from font
+ 	size, icon size, and readout caret size."
+ 	^ ScriptingSystem buttonExtent y max: Preferences standardEToysFont height rounded!
- 
- 	^ 22!

Item was changed:
  ----- Method: TileMorph class>>defaultNameStemForInstances (in category 'scripting') -----
  defaultNameStemForInstances
+ 	^ 'Tile' translatedNoop!
- 	^ 'Tile'!

Item was changed:
  ----- Method: TileMorph class>>fixCaretForms (in category 'class initialization') -----
  fixCaretForms
  	"TileMorph fixCaretForms"
  	"UpPicture storeString"
  	"DownPicture storeString"
  
+ 	UpPicture _ ((ColorForm
+ 	extent: 9 at 10
+ 	depth: 1
+ 	fromArray: #( 4152360960 4152360960 3816816640 3816816640 3246391296 3246391296 2155872256 2155872256 0 0)
+ 	offset: 0 at 0)
+ 	colorsFromArray: #(#(0.321 0.807 0.321) #( )  )).
- 	UpPicture :=  Form
- 	extent: 9 at 8
- 	depth: 16
- 	fromArray: #( 0 0 60817408 0 0 0 0 60818336 0 0 0 928 60818336 60817408 0 0 928 60818336 60817408 0 0 60818336 60818336 60818336 0 928 60818336 60818336 60818336 0 928 60818336 60818336 60818336 60817408 60818336 60818336 60818336 60818336 60817408)
- 	offset: 0 at 0.
  
+ 	DownPicture _ ((ColorForm
+ 	extent: 9 at 10
+ 	depth: 1
+ 	fromArray: #( 0 0 2155872256 2155872256 3246391296 3246391296 3816816640 3816816640 4152360960 4152360960)
+ 	offset: 0 at 0)
+ 	colorsFromArray: #(#(0.321 0.807 0.321) #( )  )).
- 	DownPicture := Form
- 	extent: 9 at 8
- 	depth: 16
- 	fromArray: #( 60818336 60818336 60818336 60818336 60817408 928 60818336 60818336 60818336 60817408 928 60818336 60818336 60818336 0 0 60818336 60818336 60818336 0 0 928 60818336 60817408 0 0 928 60818336 60817408 0 0 0 60818336 0 0 0 0 60817408 0 0)
- 	offset: 0 at 8.
  
+ 	SuffixPicture _ (((ColorForm
+ 	extent: 6 at 11
+ 	depth: 1
+ 	fromArray: #( 2080374784 1006632960 469762048 201326592 67108864 0 67108864 201326592 469762048 1006632960 2080374784)
+ 	offset: 0 at 0)
+ 	colorsFromArray: #(#(0.321 0.807 0.321) #( )  ))
+ 	colorsFromArray: #(#(0.321 0.807 0.321) #( )  )).
+ 
+ 	RetractPicture _ ((ColorForm
+ 	extent: 6 at 11
+ 	depth: 1
+ 	fromArray: #( 4160749568 4026531840 3758096384 3221225472 2147483648 0 2147483648 3221225472 3758096384 4026531840 4160749568)
+ 	offset: 0 at 0)
+ 	colorsFromArray: #(#(0.321 0.807 0.321) #( )  )).!
- 	SuffixPicture :=  Form
- 	extent: 10 at 8
- 	depth: 16
- 	fromArray: #( 928 0 0 0 0 60818336 60818336 0 0 0 60818336 60818336 60818336 60817408 0 60818336 60818336 60818336 60818336 0 60818336 60818336 60818336 60818336 60818336 60818336 60818336 60818336 60818336 60818336 60818336 60818336 60818336 60818336 0 60818336 60818336 60818336 0 0)
- 	offset: 0 at 0!

Item was added:
+ ----- Method: TileMorph class>>implicitSelfInTilesChanged (in category '*Etoys-Squeakland-utilities') -----
+ implicitSelfInTilesChanged
+ 	"The implicitSelfInTiles preference changed.  Caution:  although this may appear to have no senders in the image, it is in fact invoked when the implicitSelfInTiles preference is toggled... so please do not delete it."
+ 
+ 	Smalltalk isMorphic ifTrue:
+ 		[ActiveWorld allScriptEditorsInProject do:
+ 			[:aScriptEditor | aScriptEditor install].
+ 		ActiveWorld allViewersInProject do:
+ 			[:aViewer | aViewer enforceImplicitSelf]]
+ 
+ "
+ (Preferences buttonForPreference: #implicitSelfInTiles) openInHand.
+ "!

Item was changed:
  ----- Method: TileMorph class>>initialize (in category 'class initialization') -----
  initialize
  	"TileMorph readInArrowGraphics    -- call manually if necessary to bring graphics forward"
  	"TileMorph initialize"
  
+ 	UpdatingOperators _ Dictionary new.
- 	UpdatingOperators := Dictionary new.
  	UpdatingOperators at: #incr: put: #+.
  	UpdatingOperators at: #decr: put: #-.
  	UpdatingOperators at: #set: put: ''.
+ 
+ 	RetractPicture ifNil: [
+ 		RetractPicture _ (SuffixPicture flipBy: #horizontal centerAt: (SuffixPicture center))].
+ 	SuffixArrowAllowance _ 5 + SuffixPicture width + RetractPicture width.
+ 	UpArrowAllowance _ 10.
+ 
+ 	EqualityOperators _ Dictionary new.
+ 	EqualityOperators at: #< put: #eToysLT:.
+ 	EqualityOperators at: #<= put: #eToysLE:.
+ 	EqualityOperators at: #> put: #eToysGT:.
+ 	EqualityOperators at: #>= put: #eToysGE:.
+ 	EqualityOperators at: #= put: #eToysEQ:.
+ 	EqualityOperators at: #~= put: #eToysNE:.
- 	self downPicture; upPicture; suffixPicture; retractPicture.
- 	SuffixArrowAllowance := 5 + self suffixPicture width + self retractPicture width.
- 	UpArrowAllowance := 10.
  !

Item was added:
+ ----- Method: TileMorph class>>updatingOperators (in category '*Etoys-Squeakland-constants') -----
+ updatingOperators
+ 
+ 	^ UpdatingOperators!

Item was changed:
  ----- Method: TileMorph>>acceptNewLiteral (in category 'code generation') -----
  acceptNewLiteral
  	"Tell the scriptEditor who I belong to that I have a new literal value."
  
  	| topScript |
+ 	topScript _ self outermostMorphThat:
- 	topScript := self outermostMorphThat:
  		[:m | m isKindOf: ScriptEditorMorph].
  	topScript ifNotNil: [topScript installWithNewLiteral].
+ 	(self ownerThatIsA: ViewerLine) ifNotNilDo:
- 	(self ownerThatIsA: ViewerLine) ifNotNil:
  		[:aLine |
  			(self ownerThatIsA: PhraseTileMorph) ifNotNil:
  				[aLine removeHighlightFeedback.
  				self layoutChanged.
  				ActiveWorld doOneSubCycle.
+ 				aLine addCommandFeedback: nil]]!
- 				aLine addCommandFeedback]]!

Item was changed:
  ----- Method: TileMorph>>addArrows (in category 'arrows') -----
  addArrows
+ 	(self class addArrowsOn: self)
+ 		in: [:array | 
+ 			upArrow := array first.
+ 			downArrow := array second]!
- 	| frame |
- 	downArrow := ImageMorph new image: DownPicture.
- 	upArrow := ImageMorph new image: UpPicture.
- 	frame := Morph new color: Color transparent.
- 	frame 
- 		layoutPolicy: TableLayout new;
- 		listDirection: #topToBottom;
- 		hResizing: #shrinkWrap; 
- 		vResizing: #shrinkWrap;
- 		cellInset: 0 at 1;
- 		layoutInset: 0 at 1.
- 	frame addMorphBack: upArrow; addMorphBack: downArrow.
- 	self addMorphFront: frame.
- !

Item was added:
+ ----- Method: TileMorph>>addCaretsAsAppropriate: (in category '*Etoys-Squeakland-arrows') -----
+ addCaretsAsAppropriate: showingCarets
+ 	"If the argument provided is true, make any expected up-down and suffix-retract carets visible; if false, hide them all."
+ 
+ 	self setVisibilityOfUpDownCarets: showingCarets.
+ 	(showingCarets and: [self couldAddSuffixArrow])
+ 		ifFalse:
+ 			[self rescindSuffixArrow.
+ 			self rescindRetractArrow]
+ 		ifTrue:
+ 			[self addSuffixArrow.
+ 			self addRetractArrow] "has its own test."
+ !

Item was changed:
  ----- Method: TileMorph>>addRetractArrow (in category 'arrows') -----
  addRetractArrow
+ 	"If it's appropriate, add the retract arrow.  Only called when suffixArrow is already present and in submorph tree."
- 	"Must be situated in a script"
  
+ 	self couldRetract ifNil: [^ self rescindRetractArrow].
+ 
+ 	retractArrow ifNil:
+ 		[retractArrow _ ImageMorph new image: RetractPicture].
+ 	self addMorph: retractArrow inFrontOf: suffixArrow.
+ 
+ 	fullBounds _ nil.
- 	self couldRetract ifNil: [^ self].
- 	retractArrow := ImageMorph new image: RetractPicture.
- 	suffixArrow ifNotNil: [
- 		self addMorph: retractArrow inFrontOf: suffixArrow].
- 	fullBounds := nil.
  	self extent: self fullBounds extent!

Item was added:
+ ----- Method: TileMorph>>addRetractArrowAnyway (in category '*Etoys-Squeakland-arrows') -----
+ addRetractArrowAnyway
+ 
+ 	retractArrow _ ImageMorph new image: RetractPicture.
+ 	suffixArrow ifNotNil: [
+ 		self addMorph: retractArrow inFrontOf: suffixArrow].
+ 	fullBounds _ nil.
+ 	self extent: self fullBounds extent!

Item was changed:
  ----- Method: TileMorph>>addSuffixArrow (in category 'arrows') -----
  addSuffixArrow
+ 	"Add a suffix arrow to the receiver, and set it in my suffixArrow instance variable.  If I already have something there, remove it first."
  
+ 	suffixArrow ifNotNil: [suffixArrow delete].
+ 	suffixArrow _ ImageMorph new image: SuffixPicture.
- 	suffixArrow := ImageMorph new image: SuffixPicture.
  	self addMorphBack: suffixArrow.!

Item was changed:
  ----- Method: TileMorph>>arrowAction: (in category 'arrows') -----
  arrowAction: delta 
  	"Do what is appropriate when an arrow on the tile is pressed; delta will  
  	be +1 or -1"
  	| index options |
  	(type == #literal
  			and: [literal isNumber])
+ 		ifTrue: [self value:(((literal + delta) printShowingDecimalPlaces: self decimalPlaces) asNumber)]
+ 		ifFalse: [options _ self options
- 		ifTrue: [self value: literal + delta]
- 		ifFalse: [options := self options
  						ifNil: [^ self].
+ 			index _ (options first indexOf: self value)
- 			index := (options first indexOf: self value)
  						+ delta.
  			self
  				value: (options first atWrap: index).
+ 			(options second atWrap: index) ifNotNilDo:
+ 				[:bt |
+ 					submorphs last
+ 						setBalloonText: bt translated]]!
- 			submorphs last
- 				setBalloonText: (options second atWrap: index)]!

Item was changed:
  ----- Method: TileMorph>>arrowDelta (in category 'mouse handling') -----
  arrowDelta
  	"Answer the amount by which a number I display should increase at a time"
  
+ 	| readout |
+ 	(readout _ self findA: UpdatingStringMorph) ifNotNil: [^readout floatPrecision ].
+ 	^1!
- 	^  self valueOfProperty: #arrowDelta ifAbsent: [1]!

Item was changed:
  ----- Method: TileMorph>>bringUpToDate (in category 'initialization') -----
  bringUpToDate
  	"Make certain, if the receiver is an object-reference tile, that it shows the current external name of the object, which may just have changed.  This only applies to the Player regime." 
  
+ 	(type == #objRef and: [actualObject isPlayerLike]) ifTrue:
+ 		[self emblazonPlayerNameOnReferenceTile]!
- 	| newLabel |
- 		(type == #objRef and: [actualObject isPlayerLike]) ifTrue:
- 		[newLabel := actualObject externalName.
- 		self isPossessive ifTrue:
- 			[newLabel := newLabel, '''s' translated].
- 		self line1: newLabel]!

Item was added:
+ ----- Method: TileMorph>>buildHPopArrows (in category '*Etoys-Squeakland-arrows popup') -----
+ buildHPopArrows
+ 	| panel left right |
+ 	self outmostScriptEditor
+ 		ifNil: [^ nil].
+ 	(retractArrow isNil
+ 			and: [suffixArrow isNil])
+ 		ifTrue: [^ nil].
+ 	panel := Morph new.
+ 	panel cornerStyle: #rounded.
+ 	left := SketchMorph new
+ 				form: (ScriptingSystem formAtKey: #LargeLeftArrow).
+ 	right := SketchMorph new
+ 				form: (ScriptingSystem formAtKey: #LargeRightArrow).
+ 	panel
+ 		color: color.
+ 	panel sticky: true.
+ 	panel layoutPolicy: TableLayout new.
+ 	panel listDirection: #leftToRight.
+ 	panel hResizing: #shrinkWrap.
+ 	panel vResizing: #shrinkWrap.
+ 	panel cellInset: 4.
+ 	panel layoutInset: 2.
+ 	retractArrow
+ 		ifNotNil: [panel addMorphBack: left].
+ 	suffixArrow
+ 		ifNotNil: [panel addMorphBack: right].
+ 	panel
+ 		on: #mouseLeave
+ 		send: #hidePopArrows
+ 		to: self.
+ 	left
+ 		on: #mouseUp
+ 		send: #popArrowRetractArrowHit:
+ 		to: self.
+ 	right
+ 		on: #mouseUp
+ 		send: #popArrowSuffixArrowHit:
+ 		to: self.
+ 	^ panel!

Item was added:
+ ----- Method: TileMorph>>buildVPopArrows (in category '*Etoys-Squeakland-arrows popup') -----
+ buildVPopArrows
+ 	| panel up down |
+ 	upArrow
+ 		ifNil: [^ nil].
+ 	panel := Morph new.
+ 	panel cornerStyle: #rounded.
+ 	up := SketchMorph new
+ 				form: (ScriptingSystem formAtKey: #LargeUpArrow).
+ 	down := SketchMorph new
+ 				form: (ScriptingSystem formAtKey: #LargeDownArrow).
+ 	panel color: color.
+ 	panel sticky: true.
+ 	panel layoutPolicy: TableLayout new.
+ 	panel listDirection: #topToBottom.
+ 	panel hResizing: #shrinkWrap.
+ 	panel vResizing: #shrinkWrap.
+ 	panel cellInset: 4.
+ 	panel layoutInset: 2.
+ 	panel addMorphBack: up.
+ 	panel addMorphBack: down.
+ 	panel
+ 		on: #mouseLeave
+ 		send: #hidePopArrows
+ 		to: self.
+ 	up
+ 		on: #mouseDown
+ 		send: #popArrowUp:
+ 		to: self.
+ 	up
+ 		on: #mouseMove
+ 		send: #popArrowMouseMove:
+ 		to: self.
+ 	down
+ 		on: #mouseDown
+ 		send: #popArrowDown:
+ 		to: self.
+ 	down
+ 		on: #mouseMove
+ 		send: #popArrowMouseMove:
+ 		to: self.
+ 	^ panel!

Item was added:
+ ----- Method: TileMorph>>couldAddSuffixArrow (in category '*Etoys-Squeakland-arrows') -----
+ couldAddSuffixArrow
+ 	"Answer whether it is appropriate for the receiver to bear a suffix arrow."
+ 
+ 	| phrase pad |
+ 	type = #operator ifTrue:
+ 		[((owner isKindOf: PhraseTileMorph) and: [owner submorphs last == self] and: [#("Point" Number) includes: owner resultType])
+ 			ifTrue: [^ true]].
+ 	(#(literal function parameter) includes: type) ifFalse: [^ false].
+ 	(pad := self ownerThatIsA: TilePadMorph) ifNil: [^ false].
+ 
+ 	(#("Point" Number) includes: pad type) ifFalse: [^ false].
+ 
+ 	phrase := pad owner.
+ 	(phrase isKindOf: TimesRow) ifTrue: [^ true].  "times-repeat situation"
+ 	(phrase isKindOf: PhraseTileMorph)
+ 		 ifTrue:
+ 			[ ^ phrase submorphs last allMorphs includes: self]
+ 		ifFalse:
+ 			[^ phrase isKindOf: FunctionTile]!

Item was changed:
  ----- Method: TileMorph>>couldRetract (in category 'arrows') -----
  couldRetract
  	"See if it makes sense to retract this tile and the op before it.  Return the phrase that gets retracted, or nil if not allowed."
+ 
  	| phrase pad |
+ 	(owner isKindOf: PhraseTileMorph)  "car's x"
+ 		ifTrue:
+ 			[phrase := owner.
+ 			((pad := phrase owner) isKindOf: TilePadMorph)
+ 				ifFalse: [^ nil]]
+ 		ifFalse:
+ 			[(owner isKindOf: TilePadMorph) ifFalse: [^ nil].
+ 			phrase := owner owner.
+ 			((pad := phrase owner) isKindOf: TilePadMorph)
+ 				ifFalse: [^ nil]].
+ 
+ 	phrase firstSubmorph type == pad type ifFalse:  "typically it will be of type Player, as in Car's x"
+ 		[phrase submorphs size < 3 ifFalse: [^ nil].	"types should have matched"
- 	(phrase := self ownerThatIsA: PhraseTileMorph) ifNil: [^ nil].
- 	(pad := phrase ownerThatIsA: TilePadMorph) ifNil: [^ nil].
- 	(phrase firstSubmorph "goodPad") type == pad type ifFalse: [
- 		phrase submorphs size < 3 ifFalse: [^ nil].	"types should have matched"
  		"Go up a level"
+ 		(phrase _ pad ownerThatIsA: PhraseTileMorph) ifNil: [^ nil].
+ 		(pad _ phrase ownerThatIsA: TilePadMorph) ifNil: [^ nil].
+ 		(phrase firstSubmorph "goodPad") type == pad type ifFalse: [^ nil]].
+ 
+ 	(self hasOwner: phrase submorphs last) ifFalse: [^ nil].
- 		(phrase := pad ownerThatIsA: PhraseTileMorph) ifNil: [^ nil].
- 		(pad := phrase ownerThatIsA: TilePadMorph) ifNil: [^ nil].
- 		(phrase firstSubmorph "goodPad") type == pad type ifFalse: [^ nil].
- 		].
  	^ phrase
  !

Item was added:
+ ----- Method: TileMorph>>decimalPlaces (in category '*Etoys-Squeakland-mouse handling') -----
+ decimalPlaces
+ 	"Answer the number of decimal places of the contained number"
+ 
+ 	| readout |
+ 	(readout _ self findA: UpdatingStringMorph) ifNotNil: [^readout decimalPlaces ].
+ 	^0!

Item was changed:
  ----- Method: TileMorph>>deleteSuffixArrow (in category 'arrows') -----
  deleteSuffixArrow
+ 	"Delete the suffix and retract arrows if present."
  
+ 	suffixArrow ifNotNil: [suffixArrow delete].
+ 	suffixArrow _ nil.
- 	suffixArrow delete.
- 	suffixArrow := nil.
  	retractArrow ifNotNil: ["backward compat"
  		retractArrow delete.
+ 		retractArrow _ nil].
- 		retractArrow := nil].
  	self updateLiteralLabel!

Item was added:
+ ----- Method: TileMorph>>downArrow (in category '*Etoys-Squeakland-accessing') -----
+ downArrow
+ 
+ 	^ downArrow
+ !

Item was added:
+ ----- Method: TileMorph>>emblazonPlayerNameOnReferenceTile (in category '*Etoys-Squeakland-initialization') -----
+ emblazonPlayerNameOnReferenceTile
+ 	"Make the string within the receiver be the right thing."
+ 
+ 	self emblazonPlayerNameOnReferenceTileWithin: (self outermostMorphThat: [:m | m isTileEditor])!

Item was added:
+ ----- Method: TileMorph>>emblazonPlayerNameOnReferenceTileWithin: (in category '*Etoys-Squeakland-initialization') -----
+ emblazonPlayerNameOnReferenceTileWithin: scriptorOrViewer
+ 	"Make the string within the receiver be the right thing."
+ 
+ 	|  newLabel usePad |
+ 	newLabel := actualObject externalName.
+ 	Preferences implicitSelfInTiles ifTrue:
+ 		[scriptorOrViewer ifNotNil:
+ 			[scriptorOrViewer playerScripted == actualObject ifTrue:
+ 				[newLabel := '']]].
+ 		
+ 	(newLabel notEmpty and: [self isPossessive]) ifTrue:
+ 		[newLabel _ newLabel, '''s' translated].
+ 
+ 	self line1: newLabel.
+ 
+ 	usePad :=  owner isKindOf: TilePadMorph.
+ 	newLabel
+ 		ifEmpty:
+ 			[usePad ifTrue: [owner hResizing: #rigid; width: 0; clipSubmorphs: true].
+ 			self hResizing: #rigid; width: 0; borderWidth: 0]
+ 		ifNotEmpty:
+ 			[usePad ifTrue: [owner hResizing: #shrinkWrap; clipSubmorphs: false].
+ 			self hResizing: #shrinkWrap; borderWidth: 1]
+ !

Item was added:
+ ----- Method: TileMorph>>hidePopArrows (in category '*Etoys-Squeakland-arrows popup') -----
+ hidePopArrows
+ 	| popArrows |
+ 	popArrows := self activeHand
+ 				valueOfProperty: #popArrows
+ 				ifAbsent: [^ self].
+ 	popArrows second
+ 		ifNotNil: [popArrows second delete].
+ 	popArrows third
+ 		ifNotNil: [popArrows third delete].
+ 	self activeHand removeProperty: #popArrows!

Item was changed:
  ----- Method: TileMorph>>initialize (in category 'initialization') -----
  initialize
  	"initialize the state of the receiver"
  	super initialize.
  	""
  	self extent: 1 @ 1.
  	self
  		typeColor: (Color
  				r: 0.8
  				g: 1.0
  				b: 0.6).
  
+ 	type _ #literal.
- 	type := #literal.
  	"#literal, #slotRef, #objRef, #operator, #expression"
+ 	slotName _ ''.
+ 	literal _ 1.
- 	slotName := ''.
- 	literal := 1.
  	self layoutPolicy: TableLayout new.
+ 	self minCellSize: 0 @ TileMorph defaultH.
  	self cellInset: 2 @ 0.
  	self layoutInset: 1 @ 0.
  	self listDirection: #leftToRight.
  	self wrapCentering: #center.
  	self hResizing: #shrinkWrap.
  	self vResizing: #spaceFill!

Item was added:
+ ----- Method: TileMorph>>isPopArrowNeeded (in category '*Etoys-Squeakland-arrows popup') -----
+ isPopArrowNeeded
+ 	^ upArrow notNil
+ 		or: [suffixArrow notNil]!

Item was changed:
  ----- Method: TileMorph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
  justDroppedInto: aMorph event: anEvent
  	"This message is sent to a dropped morph after it has been dropped on -- and been accepted by -- a drop-sensitive morph"
  
  	super justDroppedInto: aMorph event: anEvent.
  	aMorph isPlayfieldLike
  		ifTrue:
  			[self vResizing: #shrinkWrap]
  		ifFalse:
+ 			[(aMorph isTileScriptingElement or: [aMorph isKindOf: TilePadMorph]) ifTrue:
- 			[aMorph isTileScriptingElement ifTrue:
  				[self vResizing: #spaceFill]]
  !

Item was changed:
  ----- Method: TileMorph>>line1: (in category 'private') -----
  line1: line1
  	"Emblazon the receiver with the requested label.  If the receiver already has a label, make the new label be of the same class"
  
+ 	| m desiredW classToUse lab f |
+ 	classToUse _ (lab _ self labelMorph) ifNotNil: [lab class] ifNil: [StringMorph].
- 	| m desiredW classToUse lab |
- 	classToUse := (lab := self labelMorph) ifNotNil: [lab class] ifNil: [StringMorph].
  	self removeAllMorphs.
+ 	f _ ScriptingSystem fontForTiles.
+ 	(type = #operator and: [#(+ - * / // \\ < <= > >= = ~=) includes: operatorOrExpression]) ifTrue: [
+ 		f _ f emphasized: 1].
+ 	m _ classToUse contents: line1 font: f.
+ 	desiredW _ m width + 6.
- 	m := classToUse contents: line1 font: ScriptingSystem fontForTiles.
- 	desiredW := m width + 6.
  	self extent: (desiredW max: self minimumWidth) @ self class defaultH.
  	m position: self center - (m extent // 2).
  	self addMorph: m.
  !

Item was changed:
  ----- Method: TileMorph>>localeChanged (in category 'e-toy support') -----
  localeChanged
  	"Update myself to reflect the change in locale"
  
+ 	self updateWordingToMatchVocabulary.
+ 	self fullBounds.!
- 	self updateWordingToMatchVocabulary!

Item was changed:
  ----- Method: TileMorph>>mouseDown: (in category 'event handling') -----
  mouseDown: evt 
  	self setProperty: #previousLiteral toValue: self literalFromContents.
+ 	(upArrow notNil
+ 			and: [(upArrow containsPoint: evt position)
+ 					or: [downArrow containsPoint: evt position]])
+ 		ifTrue: [self setProperty: #previousPoint toValue: evt position].
- 	self setProperty: #previousPoint toValue: evt position.
  	self currentHand releaseKeyboardFocus.
  	evt hand
  		waitForClicksOrDrag: self
  		event: evt
  		selectors: {#mouseStillDown:. nil. nil. #startDrag:}
  		threshold: 5.
  	^ super mouseDown: evt!

Item was changed:
  ----- Method: TileMorph>>mouseMove: (in category 'event handling') -----
  mouseMove: evt 
+ 	"The mouse moved within the receiver; perhaps show a menu."
+ 
+ 	| aReadout |
+ 	(self options notNil and:
+ 		 [aReadout := self findA: UpdatingStringMorph.
+ 		aReadout isNil or: [aReadout putSelector notNil]])
+ 			ifTrue:  [^ self showOptions].
+ 
- 	self options
- 		ifNotNil: [^ self showOptions].
  	(self hasProperty: #previousLiteral)
  		ifFalse: [^ self].
+ 	(self hasProperty: #previousPoint)
+ 		ifFalse: [^ self grabMorph: evt].
  	self currentHand releaseKeyboardFocus.
  	"Once reviving the value at drag start"
  	literal := self valueOfProperty: #previousLiteral.
  	"Then applying delta"
  	self arrowAction: (self valueOfProperty: #previousPoint) y - evt position y * self arrowDelta abs.
  	^ super mouseMove: evt!

Item was changed:
  ----- Method: TileMorph>>mouseUp: (in category 'event handling') -----
+ mouseUp: evt
+ 	"The mouse came up in the tile; dispatch control to suffix-arrow or retract-arrow handlers if appropriate, else pass to super."
+ 
- mouseUp: evt 
  	self removeProperty: #previousLiteral.
  	self removeProperty: #previousPoint.
  	suffixArrow
  		ifNotNil: [(suffixArrow bounds containsPoint: evt cursorPoint)
  				ifTrue: [self showSuffixChoices.
  					^ self]].
  	retractArrow
  		ifNotNil: [(retractArrow bounds containsPoint: evt cursorPoint)
+ 				ifTrue: [self retractArrowHit.
- 				ifTrue: [self deleteLastTwoTiles.
  					^ self]].
  	^ super mouseUp: evt!

Item was changed:
  ----- Method: TileMorph>>options (in category 'accessing') -----
  options
  	"Answer the options of the tile for an arrow"
  	(type == #literal
  			and: [literal isKindOf: Boolean])
+ 		ifTrue: [^ {{true. false}. #('true' 'false' ) translatedNoop}].
- 		ifTrue: [^ {{true. false}. #('true' 'false' )}].
  	operatorOrExpression
  		ifNil: [^ nil].
  	(ScriptingSystem arithmeticalOperatorsAndHelpStrings first includes: operatorOrExpression)
  		ifTrue: [^ ScriptingSystem arithmeticalOperatorsAndHelpStrings].
  	(ScriptingSystem numericComparitorsAndHelpStrings first includes: operatorOrExpression)
  		ifTrue: [self receiverType = #Number
  				ifTrue: [^ ScriptingSystem numericComparitorsAndHelpStrings]
+ 				ifFalse: [^ #(#(#= #~=) #('equal' 'not equal')) translatedNoop ]].
- 				ifFalse: [^ #(#(#= #~=) #('equal' 'not equal') )]].
  	^ nil!

Item was added:
+ ----- Method: TileMorph>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') -----
+ parseNodeWith: encoder
+ 
+ 	| op playerBearingCode |
+ 	playerBearingCode := self playerBearingCode.	"Must determine whom is scripted for what follows to work; if it's ever nil, we've got trouble"
+ 	type = #expression 
+ 		ifTrue: 
+ 			[^ (ScriptCompiler new parserClass new parse: 'xxx ', operatorOrExpression class: UndefinedObject) block statements first].
+ 	type = #literal 
+ 		ifTrue: 
+ 			[^ encoder encodeLiteral: literal].
+ 	type == #objRef 
+ 		ifTrue: 
+ 			[^playerBearingCode == actualObject 
+ 				ifTrue: 
+ 					["If the object is the method's own 'self' then we MUST, rather than just MAY, put out 'self' rather than the referencer call, though the latter will temporarily work if only one instance of the uniclass exists."
+ 
+ 					^ encoder encodeVariable: 'self']
+ 				ifFalse: 
+ 					[(actualObject isPlayerLike and: [actualObject isSequentialStub]) ifTrue: [
+ 						^ actualObject parseNodeWith: encoder.
+ 					] ifFalse: [
+ 						^ encoder encodePlayer: actualObject]]].
+ 	type = #operator 
+ 		ifTrue: 
+ 			[op := ((UpdatingOperators includesKey: operatorOrExpression) 
+ 				and: [self precedingTileType = #slotRef]) 
+ 					ifTrue: [UpdatingOperators at: operatorOrExpression]
+ 					ifFalse: [operatorOrExpression].
+ 			^op isEmpty 
+ 				ifTrue: [self halt.]
+ 				ifFalse: [^ encoder encodeSelector: (EqualityOperators at: op ifAbsent: [op])]].
+ !

Item was changed:
  ----- Method: TileMorph>>phraseForOp:arg:resultType: (in category 'arrows') -----
  phraseForOp: op arg: arg resultType: resultType
  	"Answer a numeric-valued phrase derived from the receiver, whose extension arrow has just been hit.  Pass along my float-precision."
  
  	| phrase srcLabel distLabel |
+ 	phrase _ self presenter
- 	phrase := self presenter
  				phraseForReceiver: literal
  				op: op
  				arg: 1
  				resultType: #Number.
+ 	srcLabel _ self findA: UpdatingStringMorph.
+ 	distLabel _ phrase submorphs first submorphs first findA: UpdatingStringMorph.
+ 	srcLabel ifNotNil:
+ 		[distLabel floatPrecision: srcLabel floatPrecision].
- 	srcLabel := self findA: UpdatingStringMorph.
- 	distLabel := phrase submorphs first submorphs first findA: UpdatingStringMorph.
- 	distLabel floatPrecision: srcLabel floatPrecision.
  	^ phrase!

Item was added:
+ ----- Method: TileMorph>>popArrowDown: (in category '*Etoys-Squeakland-arrows popup') -----
+ popArrowDown: evt 
+ 	self setProperty: #previousLiteral toValue: self literalFromContents.
+ 	self setProperty: #previousPoint toValue: evt position.
+ 	evt handler
+ 		ifNotNil: [evt handler
+ 				on: #mouseStillDown
+ 				send: #popArrowDown:
+ 				to: self].
+ 	self currentHand releaseKeyboardFocus.
+ 	self arrowAction: self arrowDelta negated!

Item was added:
+ ----- Method: TileMorph>>popArrowMouseMove: (in category '*Etoys-Squeakland-arrows popup') -----
+ popArrowMouseMove: evt 
+ 	| popArrows vpanel |
+ 	popArrows := self activeHand
+ 				valueOfProperty: #popArrows
+ 				ifAbsent: [^ self].
+ 	vpanel := popArrows second.
+ 	vpanel
+ 		ifNotNil: [vpanel submorphs
+ 				do: [:each | each
+ 						on: #mouseStillDown
+ 						send: nil
+ 						to: nil]].
+ 	self mouseMove: evt!

Item was added:
+ ----- Method: TileMorph>>popArrowRetractArrowHit: (in category '*Etoys-Squeakland-arrows popup') -----
+ popArrowRetractArrowHit: evt 
+ 	self retractArrowHit.
+ 	self showPopArrows!

Item was added:
+ ----- Method: TileMorph>>popArrowSuffixArrowHit: (in category '*Etoys-Squeakland-arrows popup') -----
+ popArrowSuffixArrowHit: evt 
+ 	self showSuffixChoices.
+ 	self showPopArrows!

Item was added:
+ ----- Method: TileMorph>>popArrowUp: (in category '*Etoys-Squeakland-arrows popup') -----
+ popArrowUp: evt 
+ 	self setProperty: #previousLiteral toValue: self literalFromContents.
+ 	self setProperty: #previousPoint toValue: evt position.
+ 	evt handler
+ 		ifNotNil: [evt handler
+ 				on: #mouseStillDown
+ 				send: #popArrowUp:
+ 				to: self].
+ 	self currentHand releaseKeyboardFocus.
+ 	self arrowAction: self arrowDelta!

Item was added:
+ ----- Method: TileMorph>>rescindRetractArrow (in category '*Etoys-Squeakland-arrows') -----
+ rescindRetractArrow
+ 	"If I have a retract arrow, remove it, and nil out my retractArrow inst var."
+ 
+ 	retractArrow ifNotNil:
+ 		[retractArrow delete. 
+ 		retractArrow := nil]!

Item was added:
+ ----- Method: TileMorph>>rescindSuffixArrow (in category '*Etoys-Squeakland-arrows') -----
+ rescindSuffixArrow
+ 	"If I have a suffix arrow, remove it, and nil out my suffixArrow inst var."
+ 
+ 	suffixArrow ifNotNil:
+ 		[suffixArrow delete. 
+ 		suffixArrow := nil]!

Item was changed:
  ----- Method: TileMorph>>resultType (in category 'accessing') -----
  resultType
  	"Answer the result type of the receiver"
  
  	type == #literal 
  		ifTrue: 
  			[(literal isNumber) ifTrue: [^#Number].
  			(literal isString) ifTrue: [^#String].
  			(literal isKindOf: Boolean) ifTrue: [^#Boolean]].
+ 	(#(expression function) includes: type) ifTrue: [^ #Number].
+ 
- 	type == #expression ifTrue: [^#Number].
  	type == #objRef ifTrue: [(actualObject costume renderedMorph isMemberOf: KedamaPatchMorph) ifTrue: [^ #Patch] ifFalse: [^#Player]].
  	^#unknown!

Item was added:
+ ----- Method: TileMorph>>retractArrow (in category '*Etoys-Squeakland-accessing') -----
+ retractArrow
+ 		^ retractArrow!

Item was added:
+ ----- Method: TileMorph>>retractArrowHit (in category '*Etoys-Squeakland-arrows') -----
+ retractArrowHit
+ 	"The user hit the retract button; carry out the retraction."
+ 
+ 	| phrase pad goodPad |
+ 	(phrase _ self couldRetract) ifNil: [^ self].
+ 	pad _ phrase ownerThatIsA: TilePadMorph.
+ 	goodPad _ phrase firstSubmorph.
+ 	pad owner replaceSubmorph: pad by: goodPad.
+ 	goodPad topEditor scriptEdited!

Item was added:
+ ----- Method: TileMorph>>setDecimalPlacesFromTypeIn: (in category '*Etoys-Squeakland-misc') -----
+ setDecimalPlacesFromTypeIn: aString
+ 	self labelMorph ifNotNilDo: [:m |
+ 		m setDecimalPlacesFromTypeIn: aString]!

Item was added:
+ ----- Method: TileMorph>>setVisibilityOfUpDownCarets: (in category '*Etoys-Squeakland-arrows') -----
+ setVisibilityOfUpDownCarets: showCarets
+ 	"If the argument is true, make all the 'up and down' carets, such as those that let you change the value of a number or of a boolean constant, visible; if false, remove them from sight. "
+ 
+ 	(submorphs detect: [:m | m hasProperty: #arrows] ifNone: [nil]) ifNotNilDo:
+ 		[:wrapper |
+ 			showCarets
+ 				ifTrue:
+ 					[wrapper width: 9]
+ 				ifFalse:
+ 					[wrapper width: 0]]!

Item was added:
+ ----- Method: TileMorph>>sexpWith: (in category '*Etoys-Squeakland-code generation') -----
+ sexpWith: dictionary
+ 	"Store code representing the receiver onto the stream, with the given amount of indentation"
+ 
+ 	| playerBearingCode ownerType n p |
+ 	playerBearingCode := self playerBearingCode.	"Must determine whom is scripted for what follows to work; if it's ever nil, we've got trouble"
+ 	type = #expression 
+ 		ifTrue: 
+ 			[^ (SExpElement keyword: #code) attributeAt: #value put: operatorOrExpression; yourself]. 
+ 	type = #literal 
+ 		ifTrue: 
+ 			[n _ SExpElement keyword: #literal.
+ 			(self owner isMemberOf: TilePadMorph) ifTrue: [
+ 				n attributeAt: #type put: (ownerType _ owner type).
+ 			] ifFalse: [
+ 				n attributeAt: #type put: 'Number'
+ 			].
+ 			ownerType = #Graphic ifTrue: [
+ 				n attributeAt: #value put: (dictionary at: literal).
+ 			] ifFalse: [
+ 				ownerType = #String ifTrue: [
+ 					n attributeAt: #value put: literal.
+ 				] ifFalse: [
+ 					n attributeAt: #value put: literal asString.
+ 				].
+ 			].
+ 			^ n.
+ 		].
+ 
+ 	type == #objRef 
+ 		ifTrue: 
+ 			[^playerBearingCode == actualObject 
+ 				ifTrue: 
+ 					["If the object is the method's own 'self' then we MUST, rather than just MAY, put out 'self' rather than the referencer call, though the latter will temporarily work if only one instance of the uniclass exists."
+ 
+ 					n _ SExpElement keyword: #literal.
+ 					n attributeAt: #type put: 'Player'.
+ 					n attributeAt: #value put: 'self'.
+ 					^ n.
+ 				] ifFalse: [
+ 					(actualObject isPlayerLike and: [actualObject isSequentialStub]) ifTrue: [
+ 						^ actualObject sexpWith: dictionary.
+ 					] ifFalse: [
+ 						n _ SExpElement keyword: #literal.
+ 						n attributeAt: #type put: ((actualObject costume isMemberOf: KedamaPatchMorph) ifTrue: ['Patch'] ifFalse: ['Player']).
+ 						p _ dictionary at: actualObject ifAbsent: [].
+ 						n attributeAt: #value put: (p ifNotNil: [p idref] ifNil: ['nil']).
+ 						^ n]]].
+ !

Item was changed:
  ----- Method: TileMorph>>showOptions (in category 'mouse handling') -----
  showOptions
  	"The receiver is a tile that represents an operator; a click on the 
  	receiver's label will pop up a menu of alternative operator choices"
+ 	| result menuChoices word |
+ 	menuChoices _ (self options first collect: [:each | each asString]) collect: [:each | 
- 	| result menuChoices |
- 	menuChoices := (self options first collect: [:each | each asString translated]) collect: [:each | | word | 
  							word := self currentVocabulary translatedWordingFor: each asSymbol.
  							word isEmpty
  								ifTrue: ['<-']
  								ifFalse: [word]].
+ 	result _ (SelectionMenu labelList: menuChoices lines: nil selections: self options first) startUp.
- 	result := UIManager default chooseFrom: menuChoices values: self options first.
  	result 
  		ifNotNil: [self value: result.
  			self scriptEdited]!

Item was added:
+ ----- Method: TileMorph>>showPopArrows (in category '*Etoys-Squeakland-arrows popup') -----
+ showPopArrows
+ 	| vpanel hpanel |
+ 	Preferences usePopUpArrows
+ 		ifFalse: [^ self].
+ 	self hidePopArrows.
+ 	self isPopArrowNeeded
+ 		ifFalse: [^ self].
+ 	vpanel := self buildVPopArrows.
+ 	hpanel := self buildHPopArrows.
+ 	self activeHand setProperty: #popArrows toValue: {self. vpanel. hpanel}.
+ 	self layoutChanged!

Item was changed:
  ----- Method: TileMorph>>showSuffixChoices (in category 'arrows') -----
  showSuffixChoices
  	"The suffix arrow has been hit, so respond appropriately"
  
  	| plusPhrase phrase pad outer num |
+ 	ActiveEvent shiftPressed ifTrue: [^ self wrapPhraseInFunction].
- 	(phrase := self ownerThatIsA: PhraseTileMorph) ifNil: [^ self].
  
+ 	(phrase _ self ownerThatIsA: PhraseTileMorph orA: FunctionTile) ifNil: [nil].
+ 
  	(type == #literal) & (literal isNumber) ifTrue: ["Tile is a constant number"
+ 		(phrase isNil or: [phrase finalTilePadSubmorph == owner]) "pad"
- 		phrase lastSubmorph == owner "pad"
  			ifTrue: ["we are adding the first time (at end of our phrase)"
+ 				plusPhrase _ self phraseForOp: #+ arg: 1 resultType: #Number.
- 				plusPhrase := self phraseForOp: #+ arg: 1 resultType: #Number.
  				plusPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: #+).
  				owner acceptDroppingMorph: plusPhrase event: self primaryHand lastEvent.
+ 				num _ plusPhrase firstSubmorph firstSubmorph.
- 				num := plusPhrase firstSubmorph firstSubmorph.
  				num deleteSuffixArrow]].
  
+ 	(#(function expression parameter) includes: type) ifTrue:
+ 			[pad _ self ownerThatIsA: TilePadMorph.
+ 			plusPhrase _ self presenter phraseForReceiver: 1  op: #+ arg: 1 resultType: #Number.
+ 			plusPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: #+).
+ 			pad acceptDroppingMorph: plusPhrase event: self primaryHand lastEvent.
+ 			plusPhrase firstSubmorph removeAllMorphs; addMorph: self.
+ 			pad topEditor scriptEdited "recompile"].
+ 
+ 	type = #operator ifTrue: ["Tile is accessor of an expression"
- 	type == #operator ifTrue: ["Tile is accessor of an expression"
  		phrase resultType == #Number ifTrue:
+ 			[outer _ phrase ownerThatIsA: PhraseTileMorph orA: TimesRepeatTile.
+ 			pad _ self ownerThatIsA: TilePadMorph.
- 			[outer := phrase ownerThatIsA: PhraseTileMorph.
- 			pad := self ownerThatIsA: TilePadMorph.
  			outer ifNotNil:
+ 				[(outer lastSubmorph == pad or: [true]) ifTrue: [ "first time"
+ 					plusPhrase _ self presenter phraseForReceiver: 1 
- 				[outer lastSubmorph == pad ifTrue: [ "first time"
- 					plusPhrase := self presenter phraseForReceiver: 1 
  							op: #+ arg: 1 resultType: #Number.
  					plusPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: #+).
  					pad acceptDroppingMorph: plusPhrase event: self primaryHand lastEvent.
  					plusPhrase firstSubmorph removeAllMorphs; addMorph: phrase.	"car's heading"
+ 					pad topEditor scriptEdited "recompile & deal with carets"]]]].
- 					self deleteSuffixArrow.
- 					pad topEditor install "recompile"]]]].
  
+ 	(self topEditor ifNil: [phrase ifNil: [^ self]]) enforceTileColorPolicy!
- 	(phrase topEditor ifNil: [phrase]) enforceTileColorPolicy!

Item was changed:
  ----- Method: TileMorph>>storeCodeOn:indent: (in category 'code generation') -----
  storeCodeOn: aStream indent: tabCount 
  	"Store code representing the receiver onto the stream, with the given amount of indentation"
  
  	| op playerBearingCode |
  	playerBearingCode := self playerBearingCode.	"Must determine whom is scripted for what follows to work; if it's ever nil, we've got trouble"
  	type = #expression 
  		ifTrue: 
  			[^aStream
  				nextPut: $(;
  				nextPutAll: operatorOrExpression;
  				nextPut: $)].
  	type = #literal 
  		ifTrue: 
  			[^aStream
  				nextPut: $(;
  				nextPutAll: literal printString;
  				nextPut: $)].
  	type == #objRef 
  		ifTrue: 
  			[^playerBearingCode == actualObject 
  				ifTrue: 
  					["If the object is the method's own 'self' then we MUST, rather than just MAY, put out 'self' rather than the referencer call, though the latter will temporarily work if only one instance of the uniclass exists."
  
  					aStream nextPutAll: 'self']
  				ifFalse: 
  					[(actualObject isPlayerLike and: [actualObject isSequentialStub]) ifTrue: [
  						actualObject storeCodeOn: aStream indent: tabCount.
  					] ifFalse: [
  						 Preferences capitalizedReferences 
  						ifTrue: 
  							["Global dictionary References"
  
  							self flag: #deferred.	"Start deploying the meesage-receiver hints soon"
  							aStream nextPutAll: actualObject uniqueNameForReference]
  						ifFalse: 
  							["old class-inst-var-based scheme used  Feb 1998 to Oct 2000, and indeed
  						ongoing in school year 2000-01 at the open school"
  
  							aStream nextPutAll: 'self class '.
  							aStream 
  								nextPutAll: (playerBearingCode class referenceSelectorFor: actualObject)]]]].
  	type = #operator 
  		ifTrue: 
  			[op := ((UpdatingOperators includesKey: operatorOrExpression) 
  				and: [self precedingTileType = #slotRef]) 
  					ifTrue: [UpdatingOperators at: operatorOrExpression]
  					ifFalse: [operatorOrExpression].
  			^op isEmpty 
  				ifTrue: [aStream position: aStream position - 1]
+ 				ifFalse: [aStream nextPutAll: (EqualityOperators at: op ifAbsent: [op])]].
- 				ifFalse: [aStream nextPutAll: op]]
  
  	"The following branch has long been disused
  	type = #slotRef ifTrue:
  		[self isThisEverCalled.
+ 		refType _ self slotRefType.
- 		refType := self slotRefType.
  		refType = #get ifTrue:
  			[^ aStream
  				nextPutAll: targetName;
  				space;
  				nextPutAll: (Utilities getterSelectorFor: slotName)].
  		refType = #set ifTrue:
  			[^ aStream
  				nextPutAll: targetName;
  				space;
  				nextPutAll: (Utilities setterSelectorFor: slotName);
  				nextPut: $:].
  		refType = #update ifTrue:
  			[^ aStream
  				nextPutAll: targetName;
  				space;
  				nextPutAll: slotName;
  				nextPutAll: ': ';
  				nextPutAll: targetName;
  				space;
  				nextPutAll: slotName]]"!

Item was added:
+ ----- Method: TileMorph>>suffixArrow (in category '*Etoys-Squeakland-accessing') -----
+ suffixArrow 
+ 	^ suffixArrow!

Item was added:
+ ----- Method: TileMorph>>unhibernate (in category '*Etoys-Squeakland-as yet unclassified') -----
+ unhibernate
+ 
+ 	| l |
+ 	l := self labelMorph.
+ 	l ifNotNil: [l label: l contents font: Preferences standardEToysFont].
+ 	self removeProperty: #needsLayoutFixed.
+ !

Item was added:
+ ----- Method: TileMorph>>upArrow (in category '*Etoys-Squeakland-accessing') -----
+ upArrow
+ 
+ 	^ upArrow
+ !

Item was changed:
  ----- Method: TileMorph>>updateWordingToMatchVocabulary (in category 'initialization') -----
  updateWordingToMatchVocabulary
  	"The current vocabulary has changed; change the wording on my face, if appropriate"
  
  	| aMethodInterface |
  	type == #operator ifTrue:
  		[self line1: (self currentVocabulary tileWordingForSelector: operatorOrExpression).
  		(ScriptingSystem doesOperatorWantArrows: operatorOrExpression)
  			ifTrue: [self addArrows].
  		self updateLiteralLabel.
  
+ 		aMethodInterface _ self currentVocabulary methodInterfaceAt: operatorOrExpression
- 		aMethodInterface := self currentVocabulary methodInterfaceAt: operatorOrExpression
  			ifAbsent: [
  				Vocabulary eToyVocabulary
  					methodInterfaceAt: operatorOrExpression ifAbsent: [^ self]].
  		self setBalloonText: aMethodInterface documentation.
  	].
  
  	type == #objRef ifTrue: [
  		self isPossessive
  			ifTrue: [self bePossessive]
+ 			ifFalse: [
+ 				self labelMorph ifNotNilDo: [:label |
+ 					label  contents: self actualObject nameForViewer asSymbol translated]
+ 				]
+ 			].
- 			ifFalse: [self labelMorph contents: self actualObject nameForViewer asSymbol translated]].
  
  		"submorphs last setBalloonText: aMethodInterface documentation"!

Item was added:
+ ----- Method: TileMorph>>wrapPhraseInFunction (in category '*Etoys-Squeakland-arrows') -----
+ wrapPhraseInFunction
+ 	"The user made a gesture requesting that the phrase for which the receiver bears the widget hit be wrapped in a function.  This applies for the moment only to numeric functions"
+ 
+ 	| pad newPad functionPhrase |
+ 	pad _ self ownerThatIsA: TilePadMorph.  "Or something higher than that???"
+ 	(pad isNil or: [pad type ~= #Number]) ifTrue: [^ Beeper beep].
+ 	newPad _ TilePadMorph new setType: #Number.
+ 	newPad hResizing: #shrinkWrap; vResizing: #spacefill.
+ 	functionPhrase _ FunctionTile new.
+ 	newPad addMorphBack: functionPhrase.
+ 	pad owner replaceSubmorph: pad by: newPad.
+ 	functionPhrase operator: #abs pad: pad.
+ 	functionPhrase addSuffixArrow.
+ 	self scriptEdited
+ !

Item was changed:
  ----- Method: TilePadMorph>>acceptDroppingMorph:event: (in category 'layout') -----
  acceptDroppingMorph: aMorph event: evt 
  	"Accept the given morph within my bowels"
  
  	| editor wasPossessive morphToUse |
  	wasPossessive := submorphs notEmpty and: [submorphs first isPossessive].
+ 	morphToUse _ self morphToDropFrom: aMorph.
- 	morphToUse := self morphToDropFrom: aMorph.
  	self prepareToUndoDropOf: morphToUse.
  	self removeAllMorphs.
  	morphToUse position: self position.
  	self addMorph: morphToUse.
  	wasPossessive ifTrue: [morphToUse bePossessive].
+ 	((owner isKindOf: PhraseTileMorph) and: [self == owner submorphs last])
+ 	"Note: the non-phrase-tile-owner case is in the Times pane of a times/repeat complex"
+ 		ifTrue:
+ 			[self lastTileMorph addSuffixArrow].
+ 
+ 	self firstSubmorph hideWillingnessToAcceptDropFeedback.
+ 	(editor := self topEditor) ifNotNil: [editor scriptEdited]!
- 	morphToUse lastTile addRetractArrow.	"if can"
- 	(editor := self topEditor) ifNotNil: [editor install]!

Item was changed:
  ----- Method: TilePadMorph>>addCustomMenuItems:hand: (in category 'miscellaneous') -----
  addCustomMenuItems: aCustomMenu hand: aHandMorph
  	"Add custom menu items to the menu"
  
  	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ 	(self ownerThatIsA: ScriptEditorMorph) ifNotNil:
+ 		[aCustomMenu add: 'restore default tile' translated action: #restoreDefaultTile.
+ 		type = #Number ifTrue:
+ 			[aCustomMenu add: 'place in a function' translated action: #wrapInFunction]]!
- 	aCustomMenu add: 'restore default tile' translated action: #restoreDefaultTile.!

Item was added:
+ ----- Method: TilePadMorph>>lastTileMorph (in category '*Etoys-Squeakland-layout') -----
+ lastTileMorph
+ 	"Answer the final TileMorph in the receiver's tree -- this might be at any of three levels deep..."
+ 
+ 	| aMorph lastInPhrase |
+ 	submorphs ifEmpty: [^ nil].  "But should not normally happen."
+ 
+ 	((aMorph _ submorphs first) isTileMorph) ifTrue: [^ aMorph].
+ 	"If first submorph is not a TileMorph, it will be a PhraseTileMorph so..."	
+ 
+ 	(lastInPhrase := aMorph submorphs last) isTileMorph ifTrue: [^ lastInPhrase].
+ 	"If the last morph in the phrase is not a Tile, then it's a TilePadMorph..."
+ 
+ 	^ lastInPhrase lastTileMorph!

Item was changed:
  ----- Method: TilePadMorph>>mouseEnterDragging: (in category 'event handling') -----
  mouseEnterDragging: evt
+ 	"The mouse entered the receiver's interior dragging something."
+ 
+ 	evt hand hasSubmorphs ifFalse: [^ self].
+ 	(self wantsDroppedMorph: evt hand firstSubmorph event: evt) ifTrue:
+ 		[submorphs ifNotEmpty:
+ 			[self firstSubmorph showWillingnessToAcceptDropFeedback]]!
- 	evt hand hasSubmorphs ifFalse:[^self].
- 	(self wantsDroppedMorph: evt hand firstSubmorph event: evt) ifTrue:[
- 		self firstSubmorph color: Color green.
- 	].
- !

Item was changed:
  ----- Method: TilePadMorph>>mouseLeaveDragging: (in category 'event handling') -----
  mouseLeaveDragging: evt
+ 	"The mouse just left the interior of the receiver whilst dragging something.  If appropriate, take down beckoning feedback; if Ithe mouse is still within the interior of a surrounding pad, call its mouseEnterDragging: method."
+ 
+ 	| aPad |
+ 	evt hand hasSubmorphs ifFalse: [^ self].
+ 	(self wantsDroppedMorph: evt hand firstSubmorph event: evt) ifTrue:
+ 		[submorphs ifNotEmpty: [self firstSubmorph hideWillingnessToAcceptDropFeedback].
+ 		aPad := self ownerSatisfying:
+ 			[:m | (m isKindOf: TilePadMorph) and: [m bounds containsPoint: evt cursorPoint] and: [m wantsDroppedMorph: evt hand firstSubmorph event: evt]].
+ 		aPad ifNotNil: [aPad mouseEnterDragging: evt]]!
- 	evt hand hasSubmorphs ifFalse:[^self].
- 	(self wantsDroppedMorph: evt hand firstSubmorph event: evt) ifTrue:[
- 		self firstSubmorph useUniformTileColor.
- 	].!

Item was added:
+ ----- Method: TilePadMorph>>parseNodeWith: (in category '*Etoys-Squeakland-code generation') -----
+ parseNodeWith: encoder
+ 
+ 	^ (submorphs at: 1) parseNodeWith: encoder.
+ !

Item was added:
+ ----- Method: TilePadMorph>>scriptEdited (in category '*Etoys-Squeakland-miscellaneous') -----
+ scriptEdited
+ 	"Tell the scriptEditor who I belong to that I have changed."
+ 
+ 	| him |
+ 	(him _ self outermostMorphThat: [:m| m isKindOf: ScriptEditorMorph])
+ 		ifNotNil: [him scriptEdited]!

Item was changed:
  ----- Method: TilePadMorph>>setToBearDefaultLiteral (in category 'miscellaneous') -----
  setToBearDefaultLiteral
  	"Set the receiver so that it contains only a tile reflecting the default literal value for a pad of this type"
  
+ 	| wasPossessive sm toAdd |
+ 	wasPossessive := (type = #Player) and: [(sm := submorphs at: 1 ifAbsent: [nil]) notNil] and: [sm isPossessive].
  	self removeAllMorphs.
+ 	toAdd := (Vocabulary vocabularyForType: type) defaultArgumentTile.
+ 	wasPossessive ifTrue:
+ 		[toAdd bePossessive].
+ 	self addMorphBack: toAdd!
- 	self addMorphBack: (Vocabulary vocabularyForType: type) defaultArgumentTile!

Item was added:
+ ----- Method: TilePadMorph>>sexpWith: (in category '*Etoys-Squeakland-code generation') -----
+ sexpWith: dictionary
+ 	submorphs size > 1 ifTrue: [self error: ''].
+ 	^ submorphs first sexpWith: dictionary.
+ !

Item was added:
+ ----- Method: TilePadMorph>>wrapInFunction (in category '*Etoys-Squeakland-miscellaneous') -----
+ wrapInFunction
+ 	"The user made a gesture requesting that the receiver be wrapped in a (numeric) function."
+ 
+ 	| newPad functionPhrase |
+ 	newPad _ TilePadMorph new setType: #Number.
+ 	newPad hResizing: #shrinkWrap; vResizing: #spacefill.
+ 	functionPhrase _ FunctionTile new.
+ 	newPad addMorphBack: functionPhrase.
+ 	owner replaceSubmorph: self by: newPad.
+ 	functionPhrase operator: #abs pad: self.
+ 	self scriptEdited!

Item was added:
+ CompoundTileMorph subclass: #TimesRepeatMorph
+ 	instanceVariableNames: 'numberOfTimesToRepeatPart whatToRepeatPart'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Scripting Tiles'!
+ 
+ !TimesRepeatMorph commentStamp: '<historical>' prior: 0!
+ This class is not used anymore. We keep it to let old projects work.
+ If we added code to auto-convert old instances of this classs to TimesRepeatTile instances, we could delete it for good.!

Item was added:
+ ----- Method: TimesRepeatMorph>>evaluateOn: (in category '*etoys-debugger') -----
+ evaluateOn: anEtoysDebugger
+ 	^ anEtoysDebugger evaluateRepeat: self!

Item was added:
+ ----- Method: TimesRepeatMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"Fully initialize the receiver."
+ 
+ 	| dummyColumn timesRow  timesRepeatColumn repeatRow separator repeatLabel placeHolder doLabel ephemerum |
+ 	submorphs _ #().
+ 	bounds _ 0 at 0 corner: 50 at 40.
+ 	self color: Color orange muchLighter.
+ 
+ 	self layoutPolicy: TableLayout new.
+ 	self "border, and layout properties in alphabetical order..."
+ 		borderColor: self color darker;
+ 		borderWidth: 2; 
+ 		cellSpacing: #none;
+ 		cellPositioning: #topLeft;
+ 		hResizing: #spaceFill;
+ 		layoutInset: 0;
+ 		listDirection: #leftToRight;
+ 		rubberBandCells: true;
+ 		vResizing: #shrinkWrap;
+ 		wrapCentering: #none.
+ 
+ 	self setNameTo: 'Repeat Complex'.
+ 
+ 	dummyColumn _ AlignmentMorph newColumn.
+ 	dummyColumn cellInset: 0; layoutInset: 0.
+ 	dummyColumn width: 0.
+ 	dummyColumn cellPositioning: #leftCenter.
+ 	dummyColumn hResizing: #shrinkWrap; vResizing: #spaceFill.
+ 	self addMorph: dummyColumn.
+ 
+ 	timesRepeatColumn _ AlignmentMorph newColumn.
+ 	timesRepeatColumn setNameTo: 'Times Repeat'.
+ 
+ 	timesRepeatColumn cellPositioning: #topLeft.
+ 	timesRepeatColumn hResizing: #spaceFill.
+  	timesRepeatColumn vResizing: #shrinkWrap.
+ 	timesRepeatColumn layoutInset: 0.
+ 	timesRepeatColumn borderWidth: 0.
+ 	timesRepeatColumn color:  Color orange muchLighter.
+ 
+ 	timesRow _ AlignmentMorph newRow color: color; layoutInset: 0.
+ 	timesRow minCellSize: (2 at 16).
+ 	timesRow setNameTo: 'Times'.
+ 	repeatLabel _ StringMorph  contents: 'Repeat' translated font:  Preferences standardEToysFont.
+ 	timesRow addMorphBack: repeatLabel.
+ 	timesRow vResizing: #shrinkWrap.
+ 	timesRow addMorphBack: (Morph new color: color; extent: 6 at 5).  "spacer"
+ 
+ 	numberOfTimesToRepeatPart := TilePadMorph new setType: #Number.
+ 	numberOfTimesToRepeatPart hResizing: #shrinkWrap; color: Color transparent.
+ 	numberOfTimesToRepeatPart addMorphBack: (TileMorph new addArrows; setLiteral: 2).
+ 	numberOfTimesToRepeatPart borderWidth: 0; layoutInset: (1 at 0).
+ 
+ 	timesRow addMorphBack: numberOfTimesToRepeatPart.
+ 	timesRow addMorphBack: (StringMorph  contents: ' times ' font: Preferences standardEToysFont).
+ 	timesRow addMorphBack: AlignmentMorph newVariableTransparentSpacer.
+ 	timesRepeatColumn addMorphBack: timesRow.
+ 
+ 	separator _ AlignmentMorph newRow color:  Color transparent.
+ 	separator vResizing: #rigid; hResizing: #spaceFill; height: 2.
+ 	separator borderWidth: 0.
+ 	timesRepeatColumn addMorphBack: separator.
+ 
+ 	repeatRow _ AlignmentMorph newRow color: color; layoutInset: 0.
+ 	repeatRow minCellSize: (2 at 16).
+ 	repeatRow setNameTo: 'Repeat '.
+ 	placeHolder _ Morph new.
+ 	placeHolder beTransparent; extent: (8 at 0).
+ 	repeatRow addMorphBack: placeHolder.
+ 	repeatRow vResizing: #shrinkWrap.
+ 	doLabel _ StringMorph  contents: 'Do' font: Preferences standardEToysFont.
+ 	repeatRow addMorphBack: doLabel.
+ 	repeatRow addMorphBack: (Morph new color: color; extent: 5 at 5).  "spacer"
+ 	repeatRow addMorphBack: (whatToRepeatPart _ ScriptEditorMorph new borderWidth: 0; layoutInset: 0).
+ 
+ 	whatToRepeatPart hResizing: #spaceFill.
+ 	whatToRepeatPart vResizing: #shrinkWrap.
+ 	whatToRepeatPart color: Color transparent.
+ 	whatToRepeatPart setNameTo: 'Script to repeat'.
+ 	whatToRepeatPart addMorphBack: (ephemerum := Morph new height: 14) beTransparent.
+ 
+ 	timesRepeatColumn addMorphBack: repeatRow.
+ 	
+ 	self addMorphBack: timesRepeatColumn.
+ 	self bounds: self fullBounds.
+ 
+ 	ephemerum delete!

Item was added:
+ ----- Method: TimesRepeatMorph>>labelMorphs (in category 'access') -----
+ labelMorphs
+ 
+ 	| w |
+ 	w := WriteStream on: (Array new: 3).
+ 	w nextPut: self submorphs second submorphs first submorphs first.
+ 	w nextPut: self submorphs second submorphs first submorphs fourth.
+ 	w nextPut: self submorphs second submorphs third submorphs second.
+ 	^ w contents.
+ !

Item was added:
+ ----- Method: TimesRepeatMorph>>parseNodeWith: (in category 'code generation') -----
+ parseNodeWith: encoder
+ 
+ 	| rec selector arg |
+ 	rec _ numberOfTimesToRepeatPart submorphs
+ 		ifEmpty:
+ 			[encoder encodeLiteral: 0]
+ 		ifNotEmpty:
+ 			[numberOfTimesToRepeatPart parseNodeWith: encoder].
+ 	selector _ #timesRepeat:.
+ 	arg _ self blockNode: whatToRepeatPart with: encoder.
+ 	^ MessageNode new
+ 				receiver: rec
+ 				selector: selector
+ 				arguments: (Array with: arg)
+ 				precedence: (selector precedence)
+ 				from: encoder
+ 				sourceRange: nil.
+ !

Item was added:
+ ----- Method: TimesRepeatMorph>>sexpWith: (in category 'code generation') -----
+ sexpWith: dictionary
+ 
+ 	| n elements e |
+ 	n _ SExpElement keyword: #loop.
+ 	n attributeAt: #type put: 'repeat'.
+ 	elements _ WriteStream on: (Array new: 3).
+ 	e _ SExpElement keyword: #initial.
+ 	e elements: (Array with: ((SExpElement keyword: #literal) attributeAt: #value put: '1'; yourself)).
+ 	elements nextPut: e.
+ 	e _ SExpElement keyword: #increment.
+ 	e elements: (Array with: ((SExpElement keyword: #literal) attributeAt: #value put: '1'; yourself)).
+ 	elements nextPut: e.
+ 
+ 	e _ SExpElement keyword: #test.
+ 	numberOfTimesToRepeatPart submorphs
+ 		ifEmpty:
+ 			[e elements: (Array with: ((SExpElement keyword: #literal) attributeAt: #value put: '0'; yourself))]
+ 		ifNotEmpty:
+ 			[e elements: (Array with: (numberOfTimesToRepeatPart sexpWith: dictionary))].
+ 
+ 	elements nextPut: e.
+ 	
+ 	elements nextPut: (self sexpBlockFor: whatToRepeatPart with: dictionary).
+ 	n elements: elements contents.
+ 	^ n.
+ 
+ !

Item was added:
+ ----- Method: TimesRepeatMorph>>storeCodeOn:indent: (in category 'code generation') -----
+ storeCodeOn: aStream indent: tabCount
+ 	"Store code representing the receiver on the stream, obeying the tab state."
+ 
+ 	aStream nextPutAll: '(('.
+ 	numberOfTimesToRepeatPart submorphs
+ 		ifEmpty:
+ 			[aStream nextPutAll: '0']
+ 		ifNotEmpty:
+ 			[numberOfTimesToRepeatPart storeCodeOn: aStream indent: tabCount + 2].
+ 	aStream nextPutAll: ' ) asInteger max: 0) timesRepeat:'.
+ 	tabCount + 1 timesRepeat: [aStream tab].
+ 	aStream nextPutAll: '['; cr.
+ 	self storeCodeBlockFor: whatToRepeatPart on: aStream indent: tabCount + 2.
+ 	aStream nextPut: $].
+ !

Item was added:
+ ----- Method: TimesRepeatMorph>>targetPartFor: (in category 'initialization') -----
+ targetPartFor: aMorph
+ 	"Return the row into which the given morph should be inserted."
+ 
+ 	| centerY |
+ 	centerY _ aMorph fullBounds center y.
+ 	{numberOfTimesToRepeatPart, whatToRepeatPart} do: [:m |
+ 		(centerY <= m bounds bottom) ifTrue: [^ m]].
+ 	^ noPart
+ !

Item was added:
+ CompoundTileMorph subclass: #TimesRepeatTile
+ 	instanceVariableNames: 'timesRow whatToRepeatPart'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Scripting Tiles'!
+ 
+ !TimesRepeatTile commentStamp: 'sw 6/15/2007 18:39' prior: 0!
+ A variant on the CompoundTileMorph that allows a section of code to be executed as many times as a numeric-control-field indicates.  For reasons of sharing and history, the CompoundTileMorph continues to be the one for test/yes/no, and this subclass disregards those three areas and adds two of its own.  An associated class is the TimesRow -- see its class comment.!

Item was added:
+ ----- Method: TimesRepeatTile>>calculateTimesToRepeat (in category '*etoys-debugger') -----
+ calculateTimesToRepeat
+ 	^ (Compiler evaluate: (String streamContents: [:stream |
+ 			self numberOfTimesToRepeatPart submorphs
+ 				ifEmpty: [stream nextPutAll: '0']
+ 				ifNotEmpty: [self numberOfTimesToRepeatPart storeCodeOn: stream indent: 0]])
+ 		for: self topEditor playerScripted
+ 		logged: false)!

Item was added:
+ ----- Method: TimesRepeatTile>>evaluateOn: (in category '*etoys-debugger') -----
+ evaluateOn: anEtoysDebugger
+ 	^ anEtoysDebugger evaluateRepeat: self!

Item was added:
+ ----- Method: TimesRepeatTile>>initialize (in category 'initialization') -----
+ initialize
+ 	"Fully initialize the receiver."
+ 
+ 	| dummyColumn  timesRepeatColumn repeatRow separator placeHolder doLabel ephemerum |
+ 	submorphs _ #().
+ 	bounds _ 0 at 0 corner: 50 at 40.
+ 	self color: Color orange muchLighter.
+ 
+ 	self layoutPolicy: TableLayout new.
+ 	self "border, and layout properties in alphabetical order..."
+ 		borderColor: self color darker;
+ 		borderWidth: 2; 
+ 		cellSpacing: #none;
+ 		cellPositioning: #topLeft;
+ 		hResizing: #spaceFill;
+ 		layoutInset: 0;
+ 		listDirection: #leftToRight;
+ 		rubberBandCells: true;
+ 		vResizing: #shrinkWrap;
+ 		wrapCentering: #none.
+ 
+ 	self setNameTo: 'Repeat Complex'.
+ 
+ 	dummyColumn _ AlignmentMorph newColumn.
+ 	dummyColumn cellInset: 0; layoutInset: 0.
+ 	dummyColumn width: 0.
+ 	dummyColumn cellPositioning: #leftCenter.
+ 	dummyColumn hResizing: #shrinkWrap; vResizing: #spaceFill.
+ 	self addMorph: dummyColumn.
+ 
+ 	timesRepeatColumn _ AlignmentMorph newColumn.
+ 	timesRepeatColumn setNameTo: 'Times Repeat'.
+ 
+ 	timesRepeatColumn cellPositioning: #topLeft.
+ 	timesRepeatColumn hResizing: #spaceFill.
+  	timesRepeatColumn vResizing: #shrinkWrap.
+ 	timesRepeatColumn layoutInset: 0.
+ 	timesRepeatColumn borderWidth: 0.
+ 	timesRepeatColumn color:  Color orange muchLighter.
+ 
+ 	timesRow _ TimesRow newRow color: color; layoutInset: 0.
+ 	timesRepeatColumn addMorphBack: timesRow.
+ 
+ 	separator _ AlignmentMorph newRow color:  Color transparent.
+ 	separator vResizing: #rigid; hResizing: #spaceFill; height: 2.
+ 	separator borderWidth: 0.
+ 	timesRepeatColumn addMorphBack: separator.
+ 
+ 	repeatRow _ AlignmentMorph newRow color: color; layoutInset: 0.
+ 	repeatRow minCellSize: (2 at 16).
+ 	repeatRow setNameTo: 'Repeat '.
+ 	placeHolder _ Morph new.
+ 	placeHolder beTransparent; extent: (8 at 0).
+ 	repeatRow addMorphBack: placeHolder.
+ 	repeatRow vResizing: #shrinkWrap.
+ 	doLabel _ StringMorph  contents: 'Do' translated font: Preferences standardEToysFont.
+ 	repeatRow addMorphBack: doLabel.
+ 	repeatRow addMorphBack: (Morph new color: color; extent: 5 at 5).  "spacer"
+ 	repeatRow addMorphBack: (whatToRepeatPart _ ScriptEditorMorph new borderWidth: 0; layoutInset: 0).
+ 
+ 	whatToRepeatPart
+ 		hResizing: #spaceFill;
+ 		vResizing: #shrinkWrap;
+ 		color: (Color transparent);
+ 		height: (Preferences standardEToysFont height);
+ 		minHeight: (Preferences standardEToysFont height);
+ 		setNameTo: ('Script to repeat' translated);
+ 		addMorphBack: ((ephemerum := Morph new height: 14) beTransparent).
+ 
+ 	timesRepeatColumn addMorphBack: repeatRow.
+ 	
+ 	self addMorphBack: timesRepeatColumn.
+ 	self bounds: self fullBounds.
+ 
+ 	ephemerum delete!

Item was added:
+ ----- Method: TimesRepeatTile>>labelMorphs (in category 'access') -----
+ labelMorphs
+ 	"Answer a list of the StringMorphs that constitute the user-visible labels in the receiver's interior -- in this case, the StringMorphs showing the words Repeat, times, and Do."
+ 
+ 	| w |
+ 	w := WriteStream on: (Array new: 3).
+ 	w nextPut: self submorphs second submorphs first submorphs first.
+ 	w nextPut: self submorphs second submorphs first submorphs fourth.
+ 	w nextPut: self submorphs second submorphs third submorphs second.
+ 	^ w contents
+ 
+ "
+ TimesRepeatTile new labelMorphs collect: [:m | m contents]
+ "
+ !

Item was added:
+ ----- Method: TimesRepeatTile>>localeChanged (in category 'localization') -----
+ localeChanged
+ 	"Hack to allow the times repeat to update when locale changes"
+ 	self labelMorphs first contents: 'Repeat' translated.
+ 	self labelMorphs second contents: (' ', ('times' translated), ' ').
+ 	self labelMorphs third contents: 'Do' translated
+ !

Item was added:
+ ----- Method: TimesRepeatTile>>nextTile (in category '*etoys-debugger') -----
+ nextTile
+ 	"Instead of just returning my next tile I return my first tile if I haven't been evaluated enough times"
+ 	self timesToRepeat <= 0
+ 		ifTrue: [^ super nextTile].
+ 	self timesToRepeat: self timesToRepeat - 1.
+ 	^ self whatToRepeatPart tiles at: 1 ifAbsent: [super nextTile]!

Item was added:
+ ----- Method: TimesRepeatTile>>numberOfTimesToRepeatPart (in category 'access') -----
+ numberOfTimesToRepeatPart
+ 	"Answer the TilePadMorph which holds the tiles defining the number of times to repeat"
+ 
+ 	^ timesRow timesPad !

Item was added:
+ ----- Method: TimesRepeatTile>>parseNodeWith: (in category 'code generation') -----
+ parseNodeWith: encoder
+ 	"Answer a MessageNode representing the receiver."
+ 
+ 	| rec selector arg timesPart |
+ 	rec _ (timesPart := self numberOfTimesToRepeatPart) submorphs
+ 		ifEmpty:
+ 			[encoder encodeLiteral: 0]
+ 		ifNotEmpty:
+ 			[timesPart parseNodeWith: encoder].
+ 	selector _ #timesRepeat:.
+ 	arg _ self blockNode: whatToRepeatPart with: encoder.
+ 	^ MessageNode new
+ 				receiver: rec
+ 				selector: selector
+ 				arguments: (Array with: arg)
+ 				precedence: (selector precedence)
+ 				from: encoder
+ 				sourceRange: nil
+ !

Item was added:
+ ----- Method: TimesRepeatTile>>sexpWith: (in category 'code generation') -----
+ sexpWith: dictionary
+ 	"Answer an SExpElement representing the receiver."
+ 
+ 	| n elements e |
+ 	n _ SExpElement keyword: #loop.
+ 	n attributeAt: #type put: 'repeat'.
+ 	elements _ WriteStream on: (Array new: 3).
+ 	e _ SExpElement keyword: #initial.
+ 	e elements: (Array with: ((SExpElement keyword: #literal) attributeAt: #value put: '1'; yourself)).
+ 	elements nextPut: e.
+ 	e _ SExpElement keyword: #increment.
+ 	e elements: (Array with: ((SExpElement keyword: #literal) attributeAt: #value put: '1'; yourself)).
+ 	elements nextPut: e.
+ 
+ 	e _ SExpElement keyword: #test.
+ 	self numberOfTimesToRepeatPart submorphs
+ 		ifEmpty:
+ 			[e elements: (Array with: ((SExpElement keyword: #literal) attributeAt: #value put: '0'; yourself))]
+ 		ifNotEmpty:
+ 			[e elements: (Array with: (self numberOfTimesToRepeatPart sexpWith: dictionary))].
+ 
+ 	elements nextPut: e.
+ 	
+ 	elements nextPut: (self sexpBlockFor: whatToRepeatPart with: dictionary).
+ 	n elements: elements contents.
+ 	^ n.
+ 
+ !

Item was added:
+ ----- Method: TimesRepeatTile>>sissComeFullyUpOnReloadFrom:to: (in category 'code generation') -----
+ sissComeFullyUpOnReloadFrom: from to: to
+ 
+ 	whatToRepeatPart borderWidth: 0; layoutInset: 0; hResizing: #spaceFill;
+ 		vResizing: #shrinkWrap;
+ 		color: Color transparent;
+ 		setNameTo: 'Script to repeat'.!

Item was added:
+ ----- Method: TimesRepeatTile>>storeCodeOn:indent: (in category 'code generation') -----
+ storeCodeOn: aStream indent: tabCount
+ 	"Store code representing the receiver on the stream, obeying the tab state."
+ 
+ 	aStream nextPutAll: '(('.
+ 	self numberOfTimesToRepeatPart submorphs
+ 		ifEmpty:
+ 			[aStream nextPutAll: '0']
+ 		ifNotEmpty:
+ 			[self numberOfTimesToRepeatPart storeCodeOn: aStream indent: tabCount + 2].
+ 	aStream nextPutAll: ' ) asInteger max: 0) timesRepeat:'.
+ 	tabCount + 1 timesRepeat: [aStream tab].
+ 	aStream nextPutAll: '['; cr.
+ 	self storeCodeBlockFor: whatToRepeatPart on: aStream indent: tabCount + 2.
+ 	aStream nextPut: $].
+ !

Item was added:
+ ----- Method: TimesRepeatTile>>targetPartFor: (in category 'initialization') -----
+ targetPartFor: aMorph
+ 	"Return the row into which the given morph should be inserted."
+ 
+ 	| centerY |
+ 	centerY _ aMorph fullBounds center y.
+ 	{self numberOfTimesToRepeatPart, whatToRepeatPart} do: [:m |
+ 		(centerY <= m bounds bottom) ifTrue: [^ m]].
+ 	^ noPart
+ !

Item was added:
+ ----- Method: TimesRepeatTile>>timesToRepeat (in category '*etoys-debugger') -----
+ timesToRepeat
+ 	^ self topEditor etoysDebugger timesToRepeat!

Item was added:
+ ----- Method: TimesRepeatTile>>timesToRepeat: (in category '*etoys-debugger') -----
+ timesToRepeat: aNumber
+ 	^ self topEditor etoysDebugger timesToRepeat: aNumber!

Item was added:
+ ----- Method: TimesRepeatTile>>whatToRepeatPart (in category '*etoys-debugger') -----
+ whatToRepeatPart
+ 	^ whatToRepeatPart!

Item was added:
+ AlignmentMorph subclass: #TimesRow
+ 	instanceVariableNames: 'timesPad'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Scripting Tiles'!
+ 
+ !TimesRow commentStamp: 'sw 6/14/2007 19:15' prior: 0!
+ A custom alignment morph that holds the "times' portion of a Times/Repeat complex!

Item was added:
+ ----- Method: TimesRow>>initialize (in category 'initialization') -----
+ initialize
+ 	"object initialization"
+ 
+ 	| repeatLabel |
+ 	super initialize.
+ 	self minCellSize: (2 at 16).
+ 	self setNameTo: 'Times'.
+ 	repeatLabel _ StringMorph  contents: 'Repeat' translated font:  Preferences standardEToysFont.
+ 	self addMorphBack: repeatLabel.
+ 	self vResizing: #shrinkWrap.
+ 	self addTransparentSpacerOfSize: (6 at 5).
+ 
+ 	timesPad := TilePadMorph new setType: #Number.
+ 	timesPad hResizing: #shrinkWrap; color: Color transparent.
+ 	timesPad addMorphBack: (TileMorph new addArrows; setLiteral: 2; addSuffixArrow; yourself).
+ 	timesPad borderWidth: 0; layoutInset: (1 at 0).
+ 
+ 	self addMorphBack: timesPad.
+ 	self addMorphBack: (StringMorph  contents: (' ', ('times' translated), ' ') font: Preferences standardEToysFont).
+ 	self addMorphBack: AlignmentMorph newVariableTransparentSpacer!

Item was added:
+ ----- Method: TimesRow>>replaceSubmorph:by: (in category 'retract-arrow processing') -----
+ replaceSubmorph: existingMorph by: newMorph
+ 	"Replace a submorph by a different morph. Fix up my  inst vars as appropriate."
+ 
+ 	super replaceSubmorph: existingMorph by: newMorph.
+ 	(newMorph isKindOf: TilePadMorph)
+ 		ifTrue:
+ 			[timesPad := newMorph]
+ !

Item was added:
+ ----- Method: TimesRow>>timesPad (in category 'accessing') -----
+ timesPad
+ 	"Answer the TilePadMorph at the top of the tile
+ 	tree for the times part. Guard against repeating
+ 	less than 0 times"
+ 	| number |
+ 	timesPad submorphs isEmpty ifTrue: [
+ 		timesPad addMorphBack: (TileMorph new addArrows; setLiteral: 0; addSuffixArrow; yourself)
+ 	].
+ 	((number := timesPad submorphs first) isKindOf: TileMorph)
+ 		ifTrue: [number literal < 0
+ 				ifTrue: [number literal: 0]].
+ 	^ timesPad!

Item was added:
+ SketchMorph subclass: #TinyPaint
+ 	instanceVariableNames: 'brush brushSize brushColor lastMouse'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Widgets'!

Item was added:
+ ----- Method: TinyPaint>>addCustomMenuItems:hand: (in category 'menu') -----
+ addCustomMenuItems: aCustomMenu hand: aHandMorph
+ 
+ 	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ 	aCustomMenu add: 'clear' translated action: #clear.
+ 	aCustomMenu add: 'pen color' translated action: #setPenColor:.
+ 	aCustomMenu add: 'pen size' translated action: #setPenSize.
+ 	aCustomMenu add: 'fill' translated action: #fill.
+ !

Item was added:
+ ----- Method: TinyPaint>>brushColor: (in category 'menu') -----
+ brushColor: aColor
+ 
+ 	brushColor _ aColor.
+ 	brush color: aColor.
+ !

Item was added:
+ ----- Method: TinyPaint>>clear (in category 'menu') -----
+ clear
+ 
+ 	self form: ((Form extent: 125 at 100 depth: 8) fillColor: color).
+ 	brush _ Pen newOnForm: originalForm.
+ 	brush roundNib: brushSize.
+ 	brush color: brushColor.
+ !

Item was added:
+ ----- Method: TinyPaint>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color veryVeryLightGray!

Item was added:
+ ----- Method: TinyPaint>>fill (in category 'menu') -----
+ fill
+ 
+ 	| fillPt |
+ 	Cursor blank show.
+ 	Cursor crossHair showWhile:
+ 		[fillPt _ Sensor waitButton - self position].
+ 	originalForm shapeFill: brushColor interiorPoint: fillPt.
+ 	self changed.
+ !

Item was added:
+ ----- Method: TinyPaint>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: evt
+ 
+ 	^ self inPartsBin not
+ !

Item was added:
+ ----- Method: TinyPaint>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 	
+ 	brushColor _ Color red.
+ 	brushSize _ 3.
+ 	self clear!

Item was added:
+ ----- Method: TinyPaint>>mouseDown: (in category 'event handling') -----
+ mouseDown: evt
+ 
+ 	lastMouse _ evt cursorPoint.
+ 	brush drawFrom: lastMouse - bounds origin to: lastMouse - bounds origin.
+ 	self invalidRect:
+ 		((lastMouse - brush sourceForm extent) corner:
+ 		 (lastMouse + brush sourceForm extent)).
+ !

Item was added:
+ ----- Method: TinyPaint>>mouseMove: (in category 'event handling') -----
+ mouseMove: evt
+ 
+ 	| p |
+ 	p _ evt cursorPoint.
+ 	p = lastMouse ifTrue: [^ self].
+ 	brush drawFrom: lastMouse - bounds origin to: p - bounds origin.
+ 	self invalidRect: (
+ 		((lastMouse min: p) - brush sourceForm extent) corner:
+ 		((lastMouse max: p) + brush sourceForm extent)).
+ 	lastMouse _ p.
+ !

Item was added:
+ ----- Method: TinyPaint>>setPenColor: (in category 'menu') -----
+ setPenColor: evt
+ 
+ 	self changeColorTarget: self selector: #brushColor: originalColor: brushColor hand: evt hand.!

Item was added:
+ ----- Method: TinyPaint>>setPenSize (in category 'menu') -----
+ setPenSize
+ 
+ 	| menu sizes nibSize |
+ 	menu _ CustomMenu new.
+ 	sizes _ (0 to: 5), (6 to: 12 by: 2), (15 to: 40 by: 5).
+ 	sizes do: [:w | menu add: w printString action: w].
+ 	nibSize _ menu startUp.
+ 	nibSize ifNotNil: [
+ 		brushSize _ nibSize.
+ 		brush roundNib: nibSize].
+ !

Item was added:
+ FormInput subclass: #ToggleButtonInput
+ 	instanceVariableNames: 'button name value state checkedByDefault'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-HTML-Forms'!
+ 
+ !ToggleButtonInput commentStamp: '<historical>' prior: 0!
+ an input from a toggle button!

Item was added:
+ ----- Method: ToggleButtonInput class>>name:value:checkedByDefault: (in category 'instance creation') -----
+ name: aName value: aValue checkedByDefault: aFlag
+ 	^ self new name: aName value: aValue checkedByDefault: aFlag!

Item was added:
+ ----- Method: ToggleButtonInput>>active (in category 'input handling') -----
+ active
+ 	^self name isNil not and: [state]!

Item was added:
+ ----- Method: ToggleButtonInput>>button: (in category 'private-initialize') -----
+ button: aButtonMorph
+ 	button _ aButtonMorph!

Item was added:
+ ----- Method: ToggleButtonInput>>name (in category 'accessing') -----
+ name
+ 	^name!

Item was added:
+ ----- Method: ToggleButtonInput>>name:value:checkedByDefault: (in category 'private-initialize') -----
+ name: aName value: aValue checkedByDefault: aFlag
+ 	name _ aName.
+ 	value _ aValue.
+ 	checkedByDefault _ aFlag.
+ 	state _ checkedByDefault!

Item was added:
+ ----- Method: ToggleButtonInput>>pressed (in category 'button state') -----
+ pressed
+ 	^state!

Item was added:
+ ----- Method: ToggleButtonInput>>pressed: (in category 'button state') -----
+ pressed: aBoolean
+ 	state _ aBoolean.
+ 	self changed: #pressed.
+ 	button ifNotNil: [button step].
+ 	^true!

Item was added:
+ ----- Method: ToggleButtonInput>>toggle (in category 'button state') -----
+ toggle
+ 	"my button has been clicked on!!"
+ 
+ 	self pressed: self pressed not.
+ 	^true!

Item was added:
+ ----- Method: ToggleButtonInput>>value (in category 'accessing') -----
+ value
+ 	^value!

Item was added:
+ Object subclass: #TopologicalSorter
+ 	instanceVariableNames: 'collection orders edges result currentTime firstGroup secondGroup intrinsics nonIntrinsics'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tweak-Kedama-ParseTreeTransformer'!

Item was added:
+ ----- Method: TopologicalSorter class>>test1 (in category 'as yet unclassified') -----
+ test1
+ "
+ 	MessageTally spyOn: [10000 timesRepeat: [TopologicalSorter test1]]
+ "
+ 
+ 	| t edges ret first second collection edgeCandidates |
+ 	t _ TopologicalSorter new.
+ 	collection _ #(1 2 3 4 5).
+ 	edgeCandidates _ {
+ 		{#(2 4). #(2 5). #(1 2)}.
+ 		{#(1 2)}.
+ 		{#(1 2). #(2 3). #(2 4)}.
+ 		{#(1 2). #(2 5). #(1 5)}.
+ 		{#(1 2). #(2 5). #(1 5). #(3 5)}.
+ 		{#(1 2). #(2 5). #(1 5). #(3 4)}.
+ 	}.
+ 
+ 	t collection: collection shuffled.
+ 	edges _ edgeCandidates atRandom.
+ 	t edges: edges.
+ 	ret _ t sort.
+ 	edges do: [:edge |
+ 		first _ ret indexOf: edge first.	
+ 		second _ ret indexOf: edge second.
+ 		self assert: first < second
+ 	].
+ 	ret _ ret reverse.
+ 	edges do: [:edge |
+ 		first _ ret indexOf: edge first.	
+ 		second _ ret indexOf: edge second.
+ 		self assert: first > second
+ 	].
+ 	^ ret reverse.
+ 
+ 
+ !

Item was added:
+ ----- Method: TopologicalSorter class>>test2 (in category 'as yet unclassified') -----
+ test2
+ "
+ 	MessageTally spyOn: [10000 timesRepeat: [TopologicalSorter test2]]
+ "
+ 
+ 	| t edges ret first second collection edgeCandidates d |
+ 	t _ TopologicalSorter new.
+ 	collection _ #(1 2 3 4 5).
+ 	edgeCandidates _ {
+ 		{1. #(2). 2. #(4 5)}.
+ 		{1. #(2)}.
+ 		{1. #(2). 2. #(3 4)}.
+ 		{1. #(2 5). 2. #(5)}.
+ 		{1. #(2 5). 2. #(5). 3. #(5)}.
+ 		{1. #(2 5). 2. #(5). 3. #(4)}.
+ 	}.
+ 	edgeCandidates _ edgeCandidates collect: [:list |
+ 		d _ IdentityDictionary new.
+ 		1 to: list size by: 2 do: [:i | d at: (list at: i) put: (list at: i+1)].
+ 		d.
+ 	].
+ 
+ 	MessageTally spyOn: [10000 timesRepeat: [t collection: collection shuffled.
+ 	edges _ edgeCandidates atRandom.
+ 	t edges: edges.
+ 	ret _ t sort.]].
+ 	edges associationsDo: [:edge |
+ 		first _ ret indexOf: edge key.
+ 		edge value do: [:value |
+ 			second _ ret indexOf: value.
+ 			self assert: first < second
+ 		].
+ 	].
+ 	ret _ ret reverse.
+ 	edges associationsDo: [:edge |
+ 		first _ ret indexOf: edge key.	
+ 		edge value do: [:value |
+ 			second _ ret indexOf: value.
+ 			self assert: first > second
+ 		].
+ 	].
+ 	^ ret reverse.
+ 
+ 
+ !

Item was added:
+ ----- Method: TopologicalSorter>>collection: (in category 'all') -----
+ collection: aCollection
+ 
+ 	collection _ aCollection.
+ 	firstGroup _ OrderedCollection new: aCollection size.
+ 	secondGroup _ OrderedCollection new: aCollection size.
+ !

Item was added:
+ ----- Method: TopologicalSorter>>currentTimeStamp (in category 'all') -----
+ currentTimeStamp
+ 
+ 	currentTime _ currentTime + 1.
+ 	^ currentTime.
+ !

Item was added:
+ ----- Method: TopologicalSorter>>edges: (in category 'all') -----
+ edges: collectionOfDictionaries
+ 
+ 	edges _ collectionOfDictionaries.
+ 	currentTime _ 0.
+ !

Item was added:
+ ----- Method: TopologicalSorter>>sort (in category 'all') -----
+ sort
+ 
+ 	| s |
+ 	collection do: [:e |
+ 		e outTime = 0 ifTrue: [firstGroup add: e] ifFalse: [secondGroup add: e].
+ 		e inTime < 0 ifTrue: [self visit: e]
+ 	].
+ 	s _ secondGroup asSortedCollection: [:a :b | a outTime > b outTime].
+ 	^ firstGroup asArray, s.
+ 
+ !

Item was added:
+ ----- Method: TopologicalSorter>>visit: (in category 'all') -----
+ visit: element
+ 
+ 	element inTime: self currentTimeStamp.
+ 	edges at: element ifPresent: [:edgesFromElement |
+ 	edgesFromElement do: [:nextElement |
+ 		(nextElement outTime  < nextElement inTime)
+ 			ifTrue: [self error: 'loop found']
+ 			ifFalse: [(nextElement inTime < 0) ifTrue: [
+ 				self visit: nextElement]]]].
+ 	element outTime: self currentTimeStamp.
+ !

Item was added:
+ ----- Method: TranscriptStream class>>windowColorSpecification (in category '*Etoys-Squeakland-window color') -----
+ windowColorSpecification
+ 	"Answer a WindowColorSpec object that declares my preference"
+ 
+ 	^ WindowColorSpec classSymbol: self name wording: 'Transcript' translatedNoop brightColor: #lightOrange pastelColor: #paleOrange helpMessage: 'The system transcript' translatedNoop!

Item was added:
+ ArrayedCollection variableSubclass: #TranslatedMethod
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Kernel-Methods'!

Item was added:
+ ----- Method: TranslatedReceiverFinder>>stringsIn:addTo: (in category '*Etoys-Squeakland-private') -----
+ stringsIn: aLiteral addTo: aCollection
+ 	"deeply find strings in aLiteral, add them to aCollection, answer true if any found"
+ 	| found |
+ 	found := false.
+ 	aLiteral literalStringsDo: [:literal |
+ 		found := true. 
+ 		aCollection add: literal].
+ 	^found!

Item was added:
+ ----- Method: TranslatedReceiverFinder>>symbolsIn:addTo: (in category '*Etoys-Squeakland-private') -----
+ symbolsIn: aLiteral addTo: aCollection
+ 	"if no strings were found in aLiteral, but it was marked as translatable, use the symbols"
+ 	aLiteral isSymbol ifTrue: [aCollection add: aLiteral].
+ 	aLiteral isArray ifTrue: [
+ 		aLiteral do: [:each | self symbolsIn: each addTo: aCollection]].
+ !

Item was added:
+ Object subclass: #TwoLevelDictionary
+ 	instanceVariableNames: 'firstLevel'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tools-File Contents Browser'!
+ 
+ !TwoLevelDictionary commentStamp: '<historical>' prior: 0!
+ A simple dictionary for the use of the TextDiffBuilder. Keys are presumed to be Points and a significant speed advantage is gained by using a dictionary of dictionaries. The first is keyed by the x-values and the second by the y-values. Only the minimum necessary protocol is implemented.!

Item was added:
+ ----- Method: TwoLevelDictionary>>at: (in category 'as yet unclassified') -----
+ at: aPoint
+ 
+ 	^(firstLevel at: aPoint x ifAbsent: [^nil]) at: aPoint y ifAbsent: [^nil]
+ !

Item was added:
+ ----- Method: TwoLevelDictionary>>at:put: (in category 'as yet unclassified') -----
+ at: aPoint put: anObject
+ 
+ 	(firstLevel at: aPoint x ifAbsentPut: [Dictionary new]) at: aPoint y put: anObject
+ !

Item was added:
+ ----- Method: TwoLevelDictionary>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 
+ 	firstLevel _ Dictionary new.!

Item was added:
+ ----- Method: TwoLevelDictionary>>keysDo: (in category 'as yet unclassified') -----
+ keysDo: aBlock
+ 
+ 	firstLevel keysAndValuesDo: [ :x :v |
+ 		v keysDo: [ :y | aBlock value: x at y]
+ 	].!

Item was added:
+ ----- Method: TwoLevelDictionary>>twoLevelKeys (in category 'as yet unclassified') -----
+ twoLevelKeys
+ 
+ 	| twoLevelSet |
+ 
+ 	twoLevelSet _ TwoLevelSet new.
+ 	self keysDo: [ :each | twoLevelSet add: each].
+ 	^twoLevelSet
+ !

Item was added:
+ Object subclass: #TwoLevelSet
+ 	instanceVariableNames: 'firstLevel'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tools-File Contents Browser'!
+ 
+ !TwoLevelSet commentStamp: '<historical>' prior: 0!
+ A simple set for the use of the TextDiffBuilder. Elements are presumed to be Points and a significant speed advantage is gained by using a dictionary of sets. The first is keyed by the x-values and the second contains the y-values. Only the minimum necessary protocol is implemented.!

Item was added:
+ ----- Method: TwoLevelSet>>add: (in category 'as yet unclassified') -----
+ add: aPoint
+ 
+ 	(firstLevel at: aPoint x ifAbsentPut: [Set new]) add: aPoint y
+ !

Item was added:
+ ----- Method: TwoLevelSet>>copy (in category 'as yet unclassified') -----
+ copy
+ 
+ 	| answer |
+ 
+ 	answer _ self class new initialize.
+ 	self do: [ :each |
+ 		answer add: each
+ 	].
+ 	^answer!

Item was added:
+ ----- Method: TwoLevelSet>>detect: (in category 'as yet unclassified') -----
+ detect: aBlock
+ 
+ 	firstLevel keysAndValuesDo: [ :x :v |
+ 		v do: [ :y | (aBlock value: x at y) ifTrue: [^x at y]]
+ 	].
+ 	^nil!

Item was added:
+ ----- Method: TwoLevelSet>>do: (in category 'as yet unclassified') -----
+ do: aBlock
+ 
+ 	firstLevel keysAndValuesDo: [ :x :v |
+ 		v do: [ :y | aBlock value: x at y]
+ 	].!

Item was added:
+ ----- Method: TwoLevelSet>>includes: (in category 'as yet unclassified') -----
+ includes: aPoint
+ 
+ 	^(firstLevel at: aPoint x ifAbsent: [^false]) includes: aPoint y!

Item was added:
+ ----- Method: TwoLevelSet>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 
+ 	firstLevel _ Dictionary new.!

Item was added:
+ ----- Method: TwoLevelSet>>isEmpty (in category 'as yet unclassified') -----
+ isEmpty
+ 
+ 	^firstLevel isEmpty!

Item was added:
+ ----- Method: TwoLevelSet>>remove: (in category 'as yet unclassified') -----
+ remove: aPoint
+ 
+ 	| lev2 |
+ 
+ 	lev2 _ firstLevel at: aPoint x ifAbsent: [^self].
+ 	lev2 remove: aPoint y ifAbsent: [].
+ 	lev2 isEmpty ifTrue: [firstLevel removeKey: aPoint x].
+ 
+ !

Item was added:
+ ----- Method: TwoLevelSet>>removeAllXAndY: (in category 'as yet unclassified') -----
+ removeAllXAndY: aPoint
+ 
+ 	| deletes |
+ 
+ 	deletes _ OrderedCollection new.
+ 	firstLevel removeKey: aPoint x ifAbsent: [].
+ 	firstLevel keysAndValuesDo: [ :x :lev2 |
+ 		lev2 remove: aPoint y ifAbsent: [].
+ 		lev2 isEmpty ifTrue: [deletes add: x].
+ 	].
+ 	deletes do: [ :each | firstLevel removeKey: each ifAbsent: []].!

Item was added:
+ ----- Method: TypeListTile>>addCaretsAsAppropriate: (in category '*Etoys-Squeakland-arrows') -----
+ addCaretsAsAppropriate: showingCarets
+ 	"If the argument provided is true, make any expected up-down and suffix-retract carets visible; if false, hide them all."
+ 
+ 	self setVisibilityOfUpDownCarets: true.  "regardless of setting..."
+ 	self addMenuIcon!

Item was changed:
  ----- Method: TypeListTile>>addMenuIcon (in category 'arrows') -----
  addMenuIcon
  	"Add a little menu icon; store it in my suffixArrow slot"
  
+ 	suffixArrow ifNotNil: [suffixArrow delete].
+ 	suffixArrow _ ImageMorph new image: (ScriptingSystem formAtKey: #MenuTriangle).
- 	suffixArrow := ImageMorph new image: (ScriptingSystem formAtKey: #MenuTriangle).
  	suffixArrow setBalloonText: 'click here to choose a new type for this parameter' translated.
  	self addMorphBack: suffixArrow!

Item was added:
+ KeyboardInputInterpreter subclass: #UTF32CNInputInterpreter
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-TextConversion'!

Item was added:
+ ----- Method: UTF32CNInputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') -----
+ nextCharFrom: sensor firstEvt: evtBuf 
+ 	| keyValue |
+ 	keyValue := evtBuf at: 6.
+ 	keyValue < 256
+ 		ifTrue: [^ (Character value: keyValue) squeakToIso].
+ 	^ Character leadingChar: SimplifiedChineseEnvironment leadingChar code: keyValue!

Item was added:
+ UTF32InputInterpreter subclass: #UTF32GreekInputInterpreter
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-TextConversion'!

Item was added:
+ ----- Method: UTF32GreekInputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') -----
+ nextCharFrom: sensor firstEvt: evtBuf 
+ 	| keyValue |
+ 	keyValue := evtBuf at: 6.
+ 	keyValue < 256
+ 		ifTrue: [^ (Character value: keyValue) squeakToIso].
+ 	^ Character leadingChar: GreekEnvironment leadingChar code: keyValue!

Item was added:
+ KeyboardInputInterpreter subclass: #UTF32NPInputInterpreter
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-TextConversion'!

Item was added:
+ ----- Method: UTF32NPInputInterpreter>>nextCharFrom:firstEvt: (in category 'all') -----
+ nextCharFrom: sensor firstEvt: evtBuf 
+ 	| keyValue |
+ 	keyValue := evtBuf at: 6.
+ 	keyValue < 256
+ 		ifTrue: [^ (Character value: keyValue) squeakToIso].
+ 	^ Character leadingChar: NepaleseEnvironment leadingChar code: keyValue!

Item was added:
+ UTF8ClipboardInterpreter subclass: #UTF8CNClipboardInterpreter
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-TextConversion'!

Item was added:
+ ----- Method: UTF8CNClipboardInterpreter>>fromSystemClipboard: (in category 'as yet unclassified') -----
+ fromSystemClipboard: aString
+ 	^aString convertFromWithConverter: UTF8TextConverter new.!

Item was added:
+ UTF8ClipboardInterpreter subclass: #UTF8GreekClipboardInterpreter
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-TextConversion'!

Item was added:
+ ----- Method: UTF8GreekClipboardInterpreter>>fromSystemClipboard: (in category 'as yet unclassified') -----
+ fromSystemClipboard: aString
+ 	| str |
+ 	str _ aString convertFromWithConverter: UTF8TextConverter new.
+ 	^ str collect: [:c |
+ 		(#(
+ 		16r20AC 16rFFFD 16r201A 16r0192 16r201E 16r2026 16r2020 16r2021
+ 		16rFFFD 16r2030 16rFFFD 16r2039 16rFFFD 16rFFFD 16rFFFD 16rFFFD
+ 		16rFFFD 16r2018 16r2019 16r201C 16r201D 16r2022 16r2013 16r2014
+ 		16rFFFD 16r2122 16rFFFD 16r203A 16rFFFD 16rFFFD 16rFFFD 16rFFFD
+ 		16r00A0 16r0385 16r0386 16r00A3 16r00A4 16r00A5 16r00A6 16r00A7
+ 		16r00A8 16r00A9 16rFFFD 16r00AB 16r00AC 16r00AD 16r00AE 16r2015
+ 		16r00B0 16r00B1 16r00B2 16r00B3 16r0384 16r00B5 16r00B6 16r00B7
+ 		16r0388 16r0389 16r038A 16r00BB 16r038C 16r00BD 16r038E 16r038F
+ 		16r0390 16r0391 16r0392 16r0393 16r0394 16r0395 16r0396 16r0397
+ 		16r0398 16r0399 16r039A 16r039B 16r039C 16r039D 16r039E 16r039F
+ 		16r03A0 16r03A1 16rFFFD 16r03A3 16r03A4 16r03A5 16r03A6 16r03A7
+ 		16r03A8 16r03A9 16r03AA 16r03AB 16r03AC 16r03AD 16r03AE 16r03AF
+ 		16r03B0 16r03B1 16r03B2 16r03B3 16r03B4 16r03B5 16r03B6 16r03B7
+ 		16r03B8 16r03B9 16r03BA 16r03BB 16r03BC 16r03BD 16r03BE 16r03BF
+ 		16r03C0 16r03C1 16r03C2 16r03C3 16r03C4 16r03C5 16r03C6 16r03C7
+ 		16r03C8 16r03C9 16r03CA 16r03CB 16r03CC 16r03CD 16r03CE 16rFFFD
+ 		) includes: c charCode) ifTrue: [Character leadingChar: GreekEnvironment leadingChar code: c charCode] ifFalse: [c]].
+ 	!

Item was added:
+ UTF8ClipboardInterpreter subclass: #UTF8JPClipboardInterpreter
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-TextConversion'!

Item was added:
+ ----- Method: UTF8JPClipboardInterpreter>>fromSystemClipboard: (in category 'as yet unclassified') -----
+ fromSystemClipboard: aString
+ 	^aString convertFromWithConverter: UTF8TextConverter new.
+ !

Item was added:
+ ----- Method: UTF8TextConverter>>errorMalformedInput (in category '*Etoys-Squeakland-conversion') -----
+ errorMalformedInput
+ 	^self error: 'Invalid utf8 input detected'!

Item was added:
+ ----- Method: UniclassScript>>allScriptGoverningButtons (in category '*Etoys-Squeakland-script editor') -----
+ allScriptGoverningButtons
+ 
+ 	"Answer all the script-activation and script-opening buttons that exist for this interface"
+ 
+ 	^ (ScriptActivationButton allInstances select: 
+ 		[:aButton | aButton uniclassScript == self]),
+ 
+ 	(ScriptOpeningButtonMorph allInstances select: 
+ 		[:aButton | aButton affiliatedScriptor == currentScriptEditor])!

Item was changed:
  ----- Method: UniclassScript>>becomeTextuallyCoded (in category 'textually coded') -----
  becomeTextuallyCoded
  	"Transform the receiver into one which is textually coded"
  
+ 	isTextuallyCoded _ true.
+ 	lastSourceString _ (playerClass sourceCodeAt: selector)  		"Save this to compare when going back to tiles"!
- 	isTextuallyCoded := true.
- 	lastSourceString := (playerClass compiledMethodAt: selector) decompileString 		"Save this to compare when going back to tiles"!

Item was changed:
  ----- Method: UniclassScript>>instantiatedScriptEditorForPlayer: (in category 'script editor') -----
  instantiatedScriptEditorForPlayer: aPlayer
  	"Return the current script editor, creating it if necessary"
  
  	currentScriptEditor ifNil:
+ 		[currentScriptEditor _ (self playerClass includesSelector: selector) 
- 		[currentScriptEditor := (self playerClass includesSelector: selector) 
  			ifTrue:
  				[Preferences universalTiles
  					ifFalse:
  						[self error: 'duplicate selector'].
  				ScriptEditorMorph new fromExistingMethod: selector forPlayer: aPlayer]
  			ifFalse:
  				[ScriptEditorMorph new setMorph: aPlayer costume scriptName: selector].
  
+ 		(defaultStatus == #ticking and: [selector numArgs == 0]) ifTrue:
+ 			[aPlayer costume arrangeToStartStepping]]
+ 	ifNotNil: [
+ 		(currentScriptEditor = #textuallyCoded and: [self playerClass includesSelector: selector]) ifTrue: [
+ 			currentScriptEditor _ ScriptEditorMorph new setMorph: aPlayer costume scriptName: selector.
+ 			self becomeTextuallyCoded.
+ 			(currentScriptEditor submorphs copyFrom: 2 to: currentScriptEditor submorphs size) do: [:m | m delete].
+ 			currentScriptEditor showSourceInScriptor.
+ 		]
+ 	].
- 		(defaultStatus == #ticking and: [selector numArgs = 0]) ifTrue:
- 			[aPlayer costume arrangeToStartStepping]].
  	
  	^ currentScriptEditor!

Item was added:
+ ----- Method: Unicode class>>digitValue: (in category '*Etoys-Squeakland-class methods') -----
+ digitValue: char
+ 
+ 	| value v |
+ 	value _ char charCode.
+ 	value <= $9 asciiValue 
+ 		ifTrue: [^value - $0 asciiValue].
+ 	value >= $A asciiValue 
+ 		ifTrue: [value <= $Z asciiValue ifTrue: [^value - $A asciiValue + 10]].
+ 
+ 	value > (DecimalProperty size - 1) ifTrue: [^ -1].
+ 	v _ DecimalProperty at: value+1.
+ 	^ (v >= 0 and: [v < 255]) ifTrue: [v] ifFalse: [-1].
+ !

Item was added:
+ ----- Method: Unicode class>>rechunkDecimalProperty (in category '*Etoys-Squeakland-class initialization') -----
+ rechunkDecimalProperty
+ "
+ 	self rechunkDecimalProperty
+ "
+ 	| newDecimalProperty every256 |
+ 	newDecimalProperty := SparseLargeTable
+ 				new: DecimalProperty size chunkSize: 32
+ 				arrayClass: ByteArray base: 1 defaultValue: 255.
+ 	every256 := 0.
+ 	'rewriting the DecimalProperty table'
+ 		displayProgressAt: Sensor cursorPoint
+ 		from: 0 to: (DecimalProperty size // 256)
+ 		during: [:bar | DecimalProperty
+ 				withIndexDo: [:code :codeIndex | 
+ 					codeIndex \\ 256 = 0
+ 						ifTrue: [bar value: (every256 := every256 + 1)].
+ 					newDecimalProperty
+ 						at: codeIndex
+ 						put: ((code >= 0 and: [code < 255]) ifTrue: [code] ifFalse: [255])]].
+ 	DecimalProperty with: newDecimalProperty do: [:e1 :e2 | (e1 = e2) ifFalse: [((e1 = -1) and: [e2 = 255]) ifFalse: [self halt]]].
+ 	DecimalProperty := newDecimalProperty zapDefaultOnlyEntries
+ !

Item was added:
+ ----- Method: Unicode class>>rechunkGeneralCategory (in category '*Etoys-Squeakland-class initialization') -----
+ rechunkGeneralCategory
+ "
+ 	self rechunkGeneralCategory
+ "
+ 	| every256 newGeneralCategory |
+ 	newGeneralCategory := SparseLargeTable
+ 				new: GeneralCategory size chunkSize: 256
+ 				arrayClass: ByteArray base: 1 defaultValue: 0.
+ 	every256 := 0.
+ 	'rewriting the GeneralCategory table'
+ 		displayProgressAt: Sensor cursorPoint
+ 		from: 0 to: (GeneralCategory size // 256)
+ 		during: [:bar | GeneralCategory
+ 				withIndexDo: [:code :codeIndex | 
+ 					codeIndex \\ 256 = 0
+ 						ifTrue: [bar value: (every256 := every256 + 1)].
+ 					newGeneralCategory
+ 						at: codeIndex
+ 						put: code]].
+ 	GeneralCategory with: newGeneralCategory do: [:e1 :e2 | (e1 = e2) ifFalse: [self halt]].
+ 	GeneralCategory := newGeneralCategory zapDefaultOnlyEntries
+ !

Item was added:
+ KeyboardInputInterpreter subclass: #UnixEUCKRInputInterpreter
+ 	instanceVariableNames: 'converter'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Multilingual-TextConversion'!

Item was added:
+ ----- Method: UnixEUCKRInputInterpreter>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 
+ 	converter _ EUCKRTextConverter new.
+ !

Item was added:
+ ----- Method: UnixEUCKRInputInterpreter>>nextCharFrom:firstEvt: (in category 'as yet unclassified') -----
+ nextCharFrom: sensor firstEvt: evtBuf
+ 
+ 	| firstChar secondChar peekEvent keyValue type stream multiChar |
+ 	keyValue _ evtBuf third.
+ 	evtBuf fourth = EventKeyChar ifTrue: [type _ #keystroke].
+ 	peekEvent _ sensor peekEvent.
+ 	(peekEvent notNil and: [peekEvent fourth = EventKeyDown]) ifTrue: [
+ 		sensor nextEvent.
+ 		peekEvent _ sensor peekEvent].
+ 
+ 	(type == #keystroke
+ 	and: [peekEvent notNil 
+ 	and: [peekEvent first = EventTypeKeyboard
+ 	and: [peekEvent fourth = EventKeyChar]]]) ifTrue: [
+ 		firstChar _ keyValue asCharacter.
+ 		secondChar _ (peekEvent third) asCharacter.
+ 		stream _ ReadStream on: (String with: firstChar with: secondChar).
+ 		multiChar _ converter nextFromStream: stream.
+ 		multiChar isOctetCharacter ifFalse: [sensor nextEvent].
+ 		^ multiChar].
+ 
+ 	^ keyValue asCharacter!

Item was removed:
- UnscriptedPlayer subclass: #UnscriptedCardPlayer
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Etoys-Scripting'!

Item was removed:
- ----- Method: UnscriptedCardPlayer>>rootClassForUniclasses (in category 'uniclass') -----
- rootClassForUniclasses
- 	"Answer the class that should be subclassed when the receiver is made into a uniclass"
- 
- 	^ CardPlayer!

Item was added:
+ ----- Method: UnscriptedPlayer>>getIndex (in category 'access') -----
+ getIndex
+ 	^ index!

Item was added:
+ ----- Method: UnscriptedPlayer>>setIndex: (in category 'access') -----
+ setIndex: t1 
+ 	index := t1!

Item was added:
+ UpdatingStringMorph subclass: #UpdatingBooleanStringMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Widgets'!
+ 
+ !UpdatingBooleanStringMorph commentStamp: '<historical>' prior: 0!
+ A customized updating-string-morph used for displaying and editing boolean values; mouse-down on one of these is inerpreted as a request to toggle.!

Item was added:
+ ----- Method: UpdatingBooleanStringMorph>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: evt
+ 	^ true!

Item was added:
+ ----- Method: UpdatingBooleanStringMorph>>informTarget (in category 'target access') -----
+ informTarget
+ 	"Determine a value by evaluating my readout, and send that value to my target"
+ 
+ 	| newValue |
+ 	(target notNil and: [putSelector notNil]) 
+ 		ifTrue: 
+ 			[newValue := self valueFromContents.
+ 			newValue ifNotNil: 
+ 					[target 
+ 						perform: putSelector
+ 						with: getSelector
+ 						with: newValue.
+ 					target isMorph ifTrue: [target changed]].
+ 			self growable 
+ 				ifTrue: 
+ 					[self
+ 						readFromTarget;
+ 						fitContents.
+ 					owner updateLiteralLabel]]!

Item was added:
+ ----- Method: UpdatingBooleanStringMorph>>mouseDown: (in category 'event handling') -----
+ mouseDown: evt
+ 	self color: Color red!

Item was added:
+ ----- Method: UpdatingBooleanStringMorph>>mouseUp: (in category 'event handling') -----
+ mouseUp: evt
+ 	(bounds containsPoint: evt cursorPoint)
+ 		ifTrue:
+ 			[self contentsClipped: (target perform: getSelector) not asString.
+ 			self informTarget]
+ 		ifFalse:
+ 			[Beeper beep].
+ 	self color: Color black!

Item was added:
+ ----- Method: UpdatingRectangleMorph>>involvesWorldColor (in category '*Etoys-Squeakland-accessing') -----
+ involvesWorldColor
+ 	"Answer whether the receiver involves the world."
+ 
+ 	^ (target isMorph and: [target isWorldMorph]) or:
+ 		[target isPlayerLike and: [target costume isWorldMorph]]!

Item was added:
+ ----- Method: UpdatingSimpleButtonMorph>>font: (in category '*Etoys-Squeakland-as yet unclassified') -----
+ font: aFontOrNil
+ 
+ 	font := aFontOrNil.
+ !

Item was added:
+ ----- Method: UpdatingStringMorph>>maximumWidth: (in category '*Etoys-Squeakland-accessing') -----
+ maximumWidth: aValue
+ 	"Set the maximum width that the receiver can have."
+ 
+ 	maximumWidth := aValue!

Item was added:
+ ----- Method: UpdatingStringMorph>>stringForPointValue: (in category '*Etoys-Squeakland-target access') -----
+ stringForPointValue: aValue
+ 	"Answer a suitably-formatted string representing the value."
+ 
+ 	^ (aValue x printShowingDecimalPlaces: self decimalPlaces), ' @ ', (aValue y  printShowingDecimalPlaces: self decimalPlaces)!

Item was added:
+ UpdatingStringMorph subclass: #UpdatingStringMorphWithArgument
+ 	instanceVariableNames: 'argumentTarget argumentGetSelector'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Widgets'!

Item was added:
+ ----- Method: UpdatingStringMorphWithArgument>>argumentTarget:argumentGetSelector: (in category 'as yet unclassified') -----
+ argumentTarget: t argumentGetSelector: s
+ 	argumentTarget _ t.
+ 	argumentGetSelector _ s!

Item was added:
+ ----- Method: UpdatingStringMorphWithArgument>>readFromTarget (in category 'target access') -----
+ readFromTarget
+ 	| v |
+ 	argumentTarget ifNil: [^ super readFromTarget].
+ 	v _ target perform: getSelector with: (argumentTarget perform: argumentGetSelector).
+ 	^ self acceptValueFromTarget: v!

Item was added:
+ ----- Method: UpdatingStringMorphWithArgument>>veryDeepFixupWith: (in category 'copying') -----
+ veryDeepFixupWith: deepCopier
+ 	"If target and arguments fields were weakly copied, fix them here.  If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"
+ 
+ super veryDeepFixupWith: deepCopier.
+ argumentTarget _ deepCopier references at: argumentTarget 
+ 			ifAbsent: [argumentTarget].
+ !

Item was added:
+ ----- Method: UpdatingStringMorphWithArgument>>veryDeepInner: (in category 'copying') -----
+ 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.
+ "argumentTarget _ argumentTarget.		Weakly copied"
+ argumentGetSelector _ argumentGetSelector veryDeepCopyWith: deepCopier.!

Item was added:
+ TextMorph subclass: #UpdatingTextMorph
+ 	instanceVariableNames: 'target getSelector growable stepTime'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Widgets'!
+ 
+ !UpdatingTextMorph commentStamp: 'asm 7/31/2003 21:27' prior: 0!
+ A TextMorph that constantly tries to show the current data from the target object.  When sent #step, it shows what the target objects has (target perform: getSelector).!

Item was added:
+ ----- Method: UpdatingTextMorph class>>on:selector: (in category 'instance creation') -----
+ on: targetObject selector: aSymbol 
+ 	"answer a new instance of the receiver on a given target and selector"
+ 	^ self new getSelector: aSymbol;
+ 		 target: targetObject!

Item was added:
+ ----- Method: UpdatingTextMorph>>contentsFromTarget (in category 'target access') -----
+ contentsFromTarget
+ 	"private - answer the contents from the receiver's target"
+ 	(target isNil
+ 			or: [getSelector isNil])
+ 		ifTrue: [^ self contents].
+ 	""
+ 	^ (target perform: getSelector) asString!

Item was added:
+ ----- Method: UpdatingTextMorph>>getSelector (in category 'accessing') -----
+ getSelector
+ 	"answer the receiver's getSelector"
+ 	^ getSelector!

Item was added:
+ ----- Method: UpdatingTextMorph>>getSelector: (in category 'accessing') -----
+ getSelector: aSymbol 
+ 	"change the receiver's getSelector"
+ 	getSelector := aSymbol!

Item was added:
+ ----- Method: UpdatingTextMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialie the receiver to have default values in its instance  
+ 	variables"
+ 	super initialize.""
+ 	stepTime := 50!

Item was added:
+ ----- Method: UpdatingTextMorph>>step (in category 'stepping and presenter') -----
+ step
+ 	"update my contents"
+ 	| newContents |
+ 	super step.
+ 	""
+ 	newContents := self contentsFromTarget.
+ 	self visible: newContents isEmpty not.
+ 	self contents: newContents!

Item was added:
+ ----- Method: UpdatingTextMorph>>stepTime (in category 'stepping and presenter') -----
+ stepTime
+ 	"answer the desired time between steps in milliseconds."
+ 	^ stepTime
+ 		ifNil: [50]!

Item was added:
+ ----- Method: UpdatingTextMorph>>stepTime: (in category 'stepping and presenter') -----
+ stepTime: mSecsPerStep 
+ 	"change the receiver's stepTime"
+ 	stepTime := mSecsPerStep rounded!

Item was added:
+ ----- Method: UpdatingTextMorph>>target (in category 'accessing') -----
+ target
+ 	"answer the receiver's target"
+ 	^ target!

Item was added:
+ ----- Method: UpdatingTextMorph>>target: (in category 'accessing') -----
+ target: anObject 
+ 	"change the receiver's target"
+ 	target := anObject!

Item was added:
+ ----- Method: UpdatingTextMorph>>veryDeepFixupWith: (in category 'copying') -----
+ veryDeepFixupWith: deepCopier
+ 	"If target and arguments fields were weakly copied, fix them here.  If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"
+ 
+ 	super veryDeepFixupWith: deepCopier.
+ 	target _ deepCopier references at: target ifAbsent: [target].
+ 	getSelector _ deepCopier references at: getSelector ifAbsent: [getSelector].
+ !

Item was added:
+ ----- Method: UpdatingTextMorph>>veryDeepInner: (in category 'copying') -----
+ 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.		Copy it weakly"
+ "getSelector _ getSelector.	Symbols are shared"
+ growable _ growable veryDeepCopyWith: deepCopier.
+ stepTime _ stepTime veryDeepCopyWith: deepCopier.
+ !

Item was added:
+ ----- Method: UserInputEvent>>position: (in category '*Etoys-Squeakland-accessing') -----
+ position: aPoint
+ 	"normally immutable, except in event recorder"
+ 	position _ aPoint!

Item was added:
+ TextMorph subclass: #UserText
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-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.!

Item was added:
+ ----- Method: UserText>>addYellowButtonMenuItemsTo:event: (in category 'menus') -----
+ 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!

Item was added:
+ ----- Method: UserText>>beAllFont: (in category 'initialization') -----
+ 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!

Item was added:
+ ----- Method: UserText>>drawOn: (in category 'drawing') -----
+ 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]!

Item was added:
+ ----- Method: UserText>>fontName:pointSize: (in category 'font') -----
+ fontName: fontname pointSize: size
+ 	"Set receiver to accommodate the given font name and size."
+ 
+ 	super fontName: fontname pointSize: size.
+ 	self updateFromParagraph!

Item was added:
+ ----- Method: UserText>>fontName:size: (in category 'font') -----
+ 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.!

Item was added:
+ ----- Method: UserText>>highlightRectChanged (in category 'editing') -----
+ highlightRectChanged
+ 	"The highlight rectangle changed... react."
+ 
+ 	(self outerBounds areasOutside: (self innerBounds insetBy: 3))
+ 		do: [ :rect | self invalidRect: rect ]!

Item was added:
+ ----- Method: UserText>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver."
+ 
+ 	super initialize.
+ 	wrapFlag _ false.
+ 	self margins: 6 at 0.
+ 	self autoFit: true. 
+ !

Item was added:
+ ----- Method: UserText>>installEditorToReplace: (in category 'private') -----
+ 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!

Item was added:
+ ----- Method: UserText>>keyStroke: (in category 'event handling') -----
+ 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]]
+ !

Item was added:
+ ----- Method: UserText>>refreshParagraph (in category 'event handling') -----
+ 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"
+ !

Item was added:
+ ----- Method: UserText>>rejectsEvent: (in category 'events-processing') -----
+ rejectsEvent: anEvent
+ 	"Answer whether the receiver rejects a given event."
+ 
+ 	self trackFocusFromEvent: anEvent.
+ 	^ (super rejectsEvent: anEvent)
+ 		or: [ anEvent isKeyboard and: [ (self handlesKeyboard: anEvent) not ] ]!

Item was added:
+ ----- Method: UserText>>releaseEditor (in category 'private') -----
+ releaseEditor
+ 	"Release the text editor, and signal that the highlight rectangle needs to be updated."
+ 
+ 	super releaseEditor.
+ 	self highlightRectChanged
+ !

Item was added:
+ ----- Method: UserText>>setExtentFromHalo: (in category 'resizing') -----
+ 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!

Item was added:
+ ----- Method: UserText>>trackFocusFromEvent: (in category 'event handling') -----
+ trackFocusFromEvent: evt
+ 	"Track focus."
+ 
+ 	evt hand keyboardFocus == self ifFalse:
+ 		[self hasFocus ifTrue: [ self highlightRectChanged. self releaseEditor]]!

Item was added:
+ ----- Method: UserText>>updateFromParagraph (in category 'private') -----
+ 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
+ !

Item was added:
+ ----- Method: Utilities class>>authorInitialsFromUser (in category '*Etoys-Squeakland-identification') -----
+ authorInitialsFromUser
+ 	"Answer the results of putting up an author-initials dialog for the user.  Answers an empty string if user cancels out of the dialog "
+ 
+ 	^ FillInTheBlank request: 'Please type your initials: ' translated
+ 		initialAnswer: (AuthorInitials ifNil: [AuthorInitials := ''])
+ 
+ 
+ "
+ Utilities authorInitialsFromUser
+ "!

Item was added:
+ ----- Method: Utilities class>>authorInitialsToStamp (in category '*Etoys-Squeakland-identification') -----
+ authorInitialsToStamp
+ 	"Answer the initials to be used to identify the current code author in a compilation time-stamp; if there are no AuthorInitials set up, put up a prompt to obtain them, but allow the user to cancel out of that dialog, in which provide a stamp indicating that no author initials were set."
+ 
+ 	AuthorInitials isEmptyOrNil ifTrue:
+ 		[self setAuthorInitials.
+ 		AuthorInitials isEmptyOrNil ifTrue:
+ 			[^ '<no author>' translated]].
+ 	^ AuthorInitials!

Item was added:
+ ----- Method: Utilities class>>defaultRepositoryChangeLogOn: (in category '*Etoys-Squeakland-fetching updates') -----
+ defaultRepositoryChangeLogOn: aStream
+ 	"Transcript clear. Utilities defaultRepositoryChangeLogOn: Transcript"
+ 	| repo updates latest previous latestVersion previousVersion added removed latestPackages previousPackages prevDep prevInfo latestInfo |
+ 	repo := MCRepositoryGroup default repositories detect: [:r |
+ 		r description = MCMcmUpdater defaultUpdateURL].
+ 	updates := repo allFileNames select: [:each | 'update-*.mcm' match: each].
+ 	updates := updates asSortedCollection:
+ 		[:a :b | a splitInteger second > b splitInteger second].
+ 	latest := repo versionFromFileNamed: updates first.
+ 	previous := repo versionFromFileNamed: updates second.
+ 	latestVersion := self versionNumberAndDateFromConfig: latest.
+ 	previousVersion := self versionNumberAndDateFromConfig: previous.
+ 	aStream nextPutAll: 'Changes from v'; print: previousVersion first;
+ 		nextPutAll: ' of '; print: previousVersion second;
+ 		nextPutAll: ' to v'; print: latestVersion first;
+ 		nextPutAll: ' of '; print: latestVersion second;
+ 		nextPutAll: ':'; cr.
+ 	aStream flush.
+ 	latestPackages := latest dependencies collect: [:dep | dep package].
+ 	previousPackages :=  previous dependencies collect: [:dep | dep package].
+ 	added := latestPackages difference: previousPackages.
+ 	removed := previousPackages difference: latestPackages.
+ 	added ifNotEmpty: [
+ 		aStream nextPutAll: 'Added packages:'.
+ 		added do: [:each | aStream space; nextPutAll: each name].
+ 		aStream cr].
+ 	removed ifNotEmpty: [
+ 		aStream nextPutAll: 'Removed packages:'.
+ 		removed do: [:each | aStream space; nextPutAll: each name].
+ 		aStream cr].
+ 	 latest dependencies do: [:latestDep |
+ 		prevDep := previous dependencies detect: [:p | latestDep package = p package] ifNone: [].
+ 		(prevDep notNil and: [prevDep versionInfo ~= latestDep versionInfo])
+ 			ifTrue: [
+ 				aStream nextPutAll: '--------------------'; cr.
+ 				prevInfo := prevDep package workingCopy ancestry findAncestor: prevDep versionInfo.
+ 				latestInfo := latestDep package workingCopy ancestry findAncestor: latestDep versionInfo.
+ 				(latestInfo allAncestorsOnPathTo: prevInfo) reverse, {latestInfo}
+ 					do: [:ver | aStream nextPutAll: ver name; cr; nextPutAll: ver message; cr]
+ 					separatedBy: [aStream cr]]].
+ 	aStream flush
+ !

Item was added:
+ ----- Method: Utilities class>>emptyScrapsBookGC (in category '*Etoys-Squeakland-scraps') -----
+ emptyScrapsBookGC
+ 	"Get rid of trashed siblings so they won't appear in allSiblingsDo:"
+ 	"Utilities emptyScrapsBookGC"
+ 
+ 	| doGC |
+ 	doGC _ (ScrapsBook ifNotNil: [ScrapsBook pages size > 1]) ~~ false.
+ 	self emptyScrapsBook.
+ 	doGC ifTrue: [Smalltalk garbageCollect].!

Item was added:
+ ----- Method: Utilities class>>isObject:memberOfOneOf: (in category '*Etoys-Squeakland-miscellaneous') -----
+ isObject: anObject memberOfOneOf: aCollectionOfClassnames
+ 	aCollectionOfClassnames do:
+ 		[:classname | (anObject isMemberOf: (Smalltalk at: classname)) ifTrue: [^ true]].
+ 	^ false!

Item was added:
+ ----- Method: Utilities class>>loggedIn (in category '*Etoys-Squeakland-identification') -----
+ loggedIn
+ 
+ 	^ LoggedIn
+ !

Item was added:
+ ----- Method: Utilities class>>loggedIn: (in category '*Etoys-Squeakland-identification') -----
+ loggedIn: aBoolean
+ 
+ 	LoggedIn := aBoolean.
+ !

Item was added:
+ ----- Method: Utilities class>>updateFromDefaultRepository (in category '*Etoys-Squeakland-fetching updates') -----
+ updateFromDefaultRepository
+ 	| config |
+ 	"Flush all caches. If a previous download failed this is often helpful"
+ 	MCFileBasedRepository flushAllCaches.
+ 	config := MCMcmUpdater updateFromDefaultRepository.
+ 	config ifNil: [^self inform: 'Repository unavailable' translated].
+ 	self setSystemVersionFromConfig: config.
+ 	self inform: ('Update completed.
+ System version is now:
+ {1}' translated format: {SystemVersion current asString}).
+ !

Item was added:
+ ----- Method: Utilities class>>versionNumberAndDateFromConfig: (in category '*Etoys-Squeakland-fetching updates') -----
+ versionNumberAndDateFromConfig: anMCConfiguration
+ 	"Answer the latest date found in anMCConfiguration (or the associated working copy), and the sum of its version numbers."
+ 
+ 	| versionNumbers versionDates |
+ 	versionNumbers := anMCConfiguration dependencies collect: [:d |
+ 		(d versionInfo name copyAfterLast: $.) asInteger].
+ 	versionDates := anMCConfiguration dependencies collect: [:d |
+ 		d versionInfo date
+ 			ifNil: [((d package workingCopy ancestry findAncestor: d versionInfo)
+ 				ifNotNilDo: [:v | v date])
+ 					ifNil: [Date fromDays: 0]]].
+ 	^{versionNumbers sum. versionDates max}.
+ !

Item was added:
+ ----- Method: VariableNode>>defaultBlockType: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultBlockType: t1 
+ 	^ #default!

Item was added:
+ ----- Method: VariableNode>>defaultMessageType (in category '*Etoys-Tweak-Kedama-Generated') -----
+ defaultMessageType
+ 	^ #none!

Item was added:
+ ----- Method: VariableNode>>emitStore:on: (in category '*Etoys-Squeakland-code generation') -----
+ emitStore: stack on: strm
+ 
+ 	self emitLong: Store on: strm!

Item was added:
+ ----- Method: VariableNode>>firstInReceivers: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ firstInReceivers: t1 
+ 	^ t1 first!

Item was added:
+ ----- Method: VariableNode>>initialNil (in category '*Etoys-Tweak-Kedama-Generated') -----
+ initialNil
+ 	^ nil!

Item was added:
+ ----- Method: VariableNode>>isStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isStmt: t1 
+ 	^ t1 = #top
+ 		or: [t1 = #condition]!

Item was added:
+ ----- Method: VariableNode>>isTest:parentNode: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTest: t1 parentNode: t2 
+ 	t1 = true
+ 		ifTrue: [^ true].
+ 	^ (t2 isMemberOf: MessageNode)
+ 		and: [t2 receiver = self
+ 				and: [t2 messageType value = #condition]]!

Item was added:
+ ----- Method: VariableNode>>isTopStmt: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ isTopStmt: t1 
+ 	t1 = nil
+ 		ifTrue: [^ true].
+ 	^ false!

Item was added:
+ ----- Method: VariableNode>>rcvr: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rcvr: t1 
+ 	^ t1!

Item was added:
+ ----- Method: VariableNode>>rewriteVariable:with:rewriteInfo: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ rewriteVariable: t1 with: t2 rewriteInfo: t3 
+ 	t2
+ 		ifNil: [^ nil].
+ 	t2 first = t1
+ 		ifTrue: [^ t3].
+ 	^ nil!

Item was added:
+ ----- Method: VariableNode>>thisNode (in category '*Etoys-Tweak-Kedama-Generated') -----
+ thisNode
+ 	^ self!

Item was added:
+ ----- Method: VariableNode>>transfer: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ transfer: t1 
+ 	^ t1!

Item was added:
+ ----- Method: VariableNode>>variableReceiver: (in category '*Etoys-Tweak-Kedama-Generated') -----
+ variableReceiver: t1 
+ 	| t2 t3 |
+ 	(self key isKindOf: LookupKey)
+ 		ifTrue: [^ self key value].
+ 	t3 := self key.
+ 	t2 := Compiler new
+ 				evaluate: t3 asString
+ 				in: nil
+ 				to: t1
+ 				notifying: nil
+ 				ifFail: []
+ 				logged: false.
+ 	^ t2!

Item was added:
+ AlignmentMorph subclass: #VariableSpacer
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Basic'!
+ 
+ !VariableSpacer commentStamp: 'sw 9/3/2007 03:00' prior: 0!
+ A transparent, space-filling, halo-shy morph, for use in alignment structures.!

Item was added:
+ ----- Method: VariableSpacer>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver to be a halo-shy variable transparent spacer."
+ 
+ 	super initialize.
+ 	self
+ 		hResizing: #spaceFill;
+ 		vResizing: #spaceFill;
+ 		layoutInset: 0;
+ 		borderWidth: 0;
+ 		extent: 1 at 1;
+ 		color: Color transparent!

Item was added:
+ ----- Method: VariableSpacer>>wantsHaloFromClick (in category 'halos and balloon help') -----
+ wantsHaloFromClick
+ 	"Answer no."
+ 
+ 	^ false!

Item was added:
+ NumberLineMorph subclass: #VerticalNumberLineMorph
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-MorphicExtras-Charts'!
+ 
+ !VerticalNumberLineMorph commentStamp: 'sw 2/15/2012 21:01' prior: 0!
+ A number line vertically oriented.!

Item was added:
+ ----- Method: VerticalNumberLineMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	"Answer a description for use in parts bins"
+ 
+ 	^ self
+ 		partName: 'V number line' translatedNoop
+ 		categories: {'Graphing' translatedNoop}
+ 		documentation: 'A vertical number line.  One possible use is as a y-axis in a graph.' translatedNoop!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>addLegendsAndMarks (in category 'initialization') -----
+ addLegendsAndMarks
+ 	"Add legends and tick-marks."
+ 
+ 	| index offset current n legendCenter markCenter aMark aLegend |
+ 	minValue ifNil: ["too early" ^ self].
+ 
+ 	index := 0.
+ 	offset := self offset.
+ 	(submorphs copyWithout: axis) do: [:m | m delete].
+ 	current := self bottom - offset.
+ 	[current  > (self top + offset)] whileTrue:
+ 		[n := minValue + index.
+ 		(n isDivisibleBy: unitsPerMark) ifTrue:
+ 			[markCenter := self left + self legendsWidth + (self marksWidth // 2) @ current.
+ 			aMark := self newMark.
+ 			self addMorph: aMark.
+ 			aMark center: markCenter; color: self color.
+ 
+ 			(n isDivisibleBy: (self marksPerLegend * self unitsPerMark)) ifTrue:
+ 				[legendCenter := self left + self legendsWidth - ((self widthOfString: n asString)
+ 									// 2) @ current + (-2 @ 0).
+ 				(n = 0 and: [showZero not]) ifFalse:
+ 					[aLegend := StringMorph contents: n asString.
+ 					self addMorph: aLegend.
+ 					aLegend center: legendCenter; color: self color]]].
+ 			current := current - pixelsPerUnit.
+ 			index := index + 1].
+ 	^ index!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>asValidExtent: (in category 'initialization') -----
+ asValidExtent: newExtent 
+ 	^ self marksWidth + self legendsWidth
+ 		@ (newExtent y max: 100)!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>centerOfAxisVertex: (in category 'initialization') -----
+ centerOfAxisVertex: n 
+ 	n = 1
+ 		ifTrue: [^ self left + self legendsWidth @ self bottom].
+ 	n = 2
+ 		ifTrue: [^ self left + self legendsWidth @ self top].
+ 	^ self error: 'Invalid vertex'!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver."
+ 
+ 	super initialize.
+ 	self extent: self allowance @ 600!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>maxValue (in category 'accessing') -----
+ maxValue
+ 	"Answer the maximum value, in graph coordinates, represented by the point at the top of the receiver."
+ 
+ 	^ minValue + (self height - self allowance / pixelsPerUnit) rounded!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>maxValue: (in category 'accessing') -----
+ maxValue: aNumber 
+ 	"Set the max value as indicated; this will typically result in a change in actual bounds of the receiver."
+ 
+ 	| newHeight |
+ 	newHeight := (aNumber - minValue * pixelsPerUnit) rounded + self allowance.
+ 	self bounds: (self bounds withTop: self bounds top - (newHeight - self height))!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>minValue: (in category 'accessing') -----
+ minValue: aNumber
+ 	"Establish the value corresponding to the lowest end of the line."
+ 
+ 	| diff |
+ 	diff := self minValue - aNumber.
+ 	self bounds: (self bounds withBottom: self bounds bottom + (self pixelsPerUnit * diff)).
+ 	super minValue: aNumber!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>newMark (in category 'initialization') -----
+ newMark
+ 	^ Morph new extent: self marksWidth @ 2!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>registerGraphCoordinate:atPlayfieldLocation: (in category 'coordinates') -----
+ registerGraphCoordinate: aGraphCoordinate atPlayfieldLocation: desiredPlayfieldCoordinate
+ 	"Fine-tuning for perfect registry."
+ 
+ 	| itsCurrentOnPlayfield delta |
+ 	itsCurrentOnPlayfield := self bottom - ((aGraphCoordinate - minValue) * pixelsPerUnit) + self offset. "relative to playfield's bottom edge"
+ 	delta := (desiredPlayfieldCoordinate - itsCurrentOnPlayfield) + owner bottom.
+ 	self bottom: self bottom + delta.
+ 	self update!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>setExtentFromHalo: (in category 'accessing') -----
+ setExtentFromHalo: anExtent
+ 	"The user having operated the yellow handle to resize the receiver, adjust the line accordingly."
+ 
+ 	| diff |
+  	diff := (anExtent y - self extent y / self pixelsPerUnit) rounded.
+ 	self minValue: (self minValue - diff)!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>setYOnGraphFor:to: (in category 'coordinates') -----
+ setYOnGraphFor: aMorph to: aNumber
+ 	"Interpreting the second argument as being in 'graph coordinates', as specified by the receiver serving as a y-axis, place the morph such that its yOnGraph is the given quantity."
+ 
+ 	| start |
+ 	start := self bottom - self offset.
+ 	aMorph center: aMorph center x @ (start - (aNumber - minValue * pixelsPerUnit))!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>verticalCoordinateForY: (in category 'coordinates') -----
+ verticalCoordinateForY: aYValue
+ 	"Answer the vertical coordinate in the 'graph coordinate space' of a number interpreted as a vertical pixel coordinate."
+ 
+ 	| start origin |
+ 	start := self bottom - self offset.
+ 	origin := start - (0 - minValue * pixelsPerUnit).
+ 	^ (origin - aYValue) / pixelsPerUnit!

Item was added:
+ ----- Method: VerticalNumberLineMorph>>verticalCoordinateOf: (in category 'coordinates') -----
+ verticalCoordinateOf: anObject
+ 	"Answer the yOnGraph, with respect to the receiver (used as a y-axis), of a morph."
+ 
+ 	^ self verticalCoordinateForY: anObject center y!

Item was added:
+ Morph subclass: #VeryPickyMorph
+ 	instanceVariableNames: 'passengerMorph'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Tools-Explorer'!
+ 
+ !VeryPickyMorph commentStamp: '<historical>' prior: 0!
+ Contributed by Bob Arning as part of the ObjectExplorer package.
+ !

Item was added:
+ ----- Method: VeryPickyMorph>>complexContents (in category 'converting') -----
+ complexContents
+ 
+ 	^passengerMorph complexContents!

Item was added:
+ ----- Method: VeryPickyMorph>>delete (in category 'submorphs-add/remove') -----
+ delete
+ 
+ 	passengerMorph ifNotNil: [passengerMorph delete].
+ 	super delete!

Item was added:
+ ----- Method: VeryPickyMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 
+ 	aCanvas frameRectangle: bounds width: 1 color: Color red!

Item was added:
+ ----- Method: VeryPickyMorph>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	super initialize.
+ 	bounds _ 0 at 0 extent: 8 at 10
+ 	"bounds _ 0 at 0 extent: 17 at 22"
+ !

Item was added:
+ ----- Method: VeryPickyMorph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
+ justDroppedInto: targetMorph event: evt
+ 
+ 	passengerMorph ifNil: [^self "delete"].
+ 	passengerMorph noLongerBeingDragged.
+ 	(targetMorph isKindOf: IndentingListItemMorph) ifFalse: [
+ 		passengerMorph changed.
+ 		passengerMorph _ nil.
+ 		owner removeMorph: self.
+ 		self privateOwner: nil.
+ 	].!

Item was added:
+ ----- Method: VeryPickyMorph>>passengerMorph: (in category 'as yet unclassified') -----
+ passengerMorph: anotherMorph
+ 
+ 	passengerMorph _ anotherMorph!

Item was added:
+ ----- Method: Viewer class>>innerBorderColor (in category '*Etoys-Squeakland-constants') -----
+ innerBorderColor
+ 	^ Preferences menuTitleBorderColor!

Item was changed:
  ----- Method: Viewer>>angleToPhrase (in category 'special phrases') -----
  angleToPhrase
  
  	| outerPhrase getTile |
  	outerPhrase := PhraseTileMorph new 
  				setOperator: #+
  				type: #Number
  				rcvrType: #Player
  				argType: #Color.	"temp dummy"
  	(outerPhrase submorphs second) delete.	"operator"
  	(outerPhrase submorphs second) delete.	"color"
+ 	getTile _ TileCommandWithArgumentMorph newKedamaAngleToTile.
+ 
- 	getTile := KedamaAngleToTile new.
  	outerPhrase addMorphBack: getTile.
  	^outerPhrase!

Item was added:
+ ----- Method: Viewer>>bearingFromPhrase (in category '*Etoys-Squeakland-special phrases') -----
+ bearingFromPhrase
+ 	"Answer a bearing-from phrase  to hand to the user."
+ 
+ 	 ^ self conjuredUpPhraseWithOperator: #bearingFrom: type: #Number!

Item was added:
+ ----- Method: Viewer>>bearingToPhrase (in category '*Etoys-Squeakland-special phrases') -----
+ bearingToPhrase
+ 	"Answer a bearing-to phrase  to hand to the user."
+ 
+ 	 ^ self conjuredUpPhraseWithOperator: #bearingTo: type: #Number!

Item was changed:
  ----- Method: Viewer>>bounceOnPhrase (in category 'special phrases') -----
  bounceOnPhrase
  
+ 	| outerPhrase getTile |
- 	| outerPhrase upHill |
  	outerPhrase := PhraseTileMorph new 
  				setOperator: #+
  				type: #Boolean
  				rcvrType: #Player
  				argType: #Color.	"temp dummy"
  	(outerPhrase submorphs second) delete.	"operator"
  	(outerPhrase submorphs second) delete.	"color"
+ 	getTile _ TileCommandWithArgumentMorph newKedamaBounceOnTile.
+ 
+ 	outerPhrase addMorphBack: getTile.
- 	upHill := KedamaBounceOnTile new.
- 	"upHill setPatchDefaultTo: (scriptedPlayer defaultPatchPlayer)."
- 	outerPhrase addMorphBack: upHill.
  	^outerPhrase.
  !

Item was changed:
  ----- Method: Viewer>>colorSeesPhrase (in category 'special phrases') -----
  colorSeesPhrase
  	"In classic tiles, answer a complete phrase that represents the colorSees test"
  
  	| outerPhrase |
  	outerPhrase := PhraseTileMorph new 
  				setOperator: #+
  				type: #Boolean
  				rcvrType: #Player
  				argType: #Color.	"temp dummy"
  	"Install (ColorSeerTile new) in middle position"
  	(outerPhrase submorphs second) delete.	"operator"
+ 	outerPhrase addMorphBack:(ColorSeerTile new showPalette: false).
- 	outerPhrase addMorphBack: ColorSeerTile new.
  	(outerPhrase submorphs second) goBehind.	"Make it third"
+ 	outerPhrase submorphs last addMorph: (ColorTileMorph new showPalette: false;
+ 				typeColor: (ScriptingSystem colorForType: #Color); yourself).
- 	outerPhrase submorphs last addMorph: (ColorTileMorph new 
- 				typeColor: (ScriptingSystem colorForType: #Color)).
  	^outerPhrase!

Item was added:
+ ----- Method: Viewer>>conjuredUpPhraseWithOperator: (in category '*Etoys-Squeakland-special phrases') -----
+ conjuredUpPhraseWithOperator: anOperator
+ 	"Answer a PhraseTileMorph carefully constructed for overlaps, overlaps-any, and touches-a -- all pseudo-slots which take a player-valued argument."
+ 
+ 	| outerPhrase |
+ 	outerPhrase := PhraseTileMorph new 
+ 				setOperator: #+
+ 				type: #Boolean
+ 				rcvrType: #Player
+ 				argType: #Player.	"temp dummy"
+ 	(outerPhrase submorphs second) delete.	"operator"
+ 	outerPhrase addMorphBack: (TileMorph new setOperator: anOperator).
+ 	(outerPhrase submorphs second) goBehind.	"Make it third"
+ 	outerPhrase submorphs last addMorph: self presenter standardPlayer tileToRefer.
+ 	^ outerPhrase!

Item was added:
+ ----- Method: Viewer>>conjuredUpPhraseWithOperator:type: (in category '*Etoys-Squeakland-special phrases') -----
+ conjuredUpPhraseWithOperator: anOperator type: aType
+ 	"Answer a PhraseTileMorph carefully constructed for overlaps, overlaps-any, and touches-a, distance to, bearing to, bearing from -- all pseudo-slots which take a player-valued argument."
+ 
+ 	| outerPhrase aTile |
+ 	outerPhrase := PhraseTileMorph new 
+ 				setOperator: #+
+ 				type: aType
+ 				rcvrType: #Player
+ 				argType: #Player.	"temp dummy"
+ 	(outerPhrase submorphs second) delete.	"operator"
+ 	aTile := TileMorph new.
+ 
+ 	aTile setOperator: anOperator andUseWording: (ScriptingSystem wordingForOperator: anOperator).
+ 	outerPhrase addMorphBack: aTile.
+ 	Smalltalk at: #AA put: aTile.
+ 	aTile addCaretsAsAppropriate: false.
+ 	(outerPhrase submorphs second) goBehind.	"Make it third"
+ 	outerPhrase submorphs last addMorph: self presenter standardPlayer tileToRefer.
+ 	^ outerPhrase!

Item was changed:
  ----- Method: Viewer>>distanceToPhrase (in category 'special phrases') -----
  distanceToPhrase
  
  	| outerPhrase getTile |
  	outerPhrase := PhraseTileMorph new 
  				setOperator: #+
  				type: #Number
  				rcvrType: #Player
  				argType: #Color.	"temp dummy"
  	(outerPhrase submorphs second) delete.	"operator"
  	(outerPhrase submorphs second) delete.	"color"
+ 	getTile _ TileCommandWithArgumentMorph newKedamaDistanceToTile.
- 	getTile := KedamaDistanceToTile new.
  	outerPhrase addMorphBack: getTile.
  	^outerPhrase!

Item was added:
+ ----- Method: Viewer>>distanceToPlayerPhrase (in category '*Etoys-Squeakland-special phrases') -----
+ distanceToPlayerPhrase
+ 	"Answer a distance-to phrase  to hand to the user."
+ 
+ 	 ^ self conjuredUpPhraseWithOperator: #distanceToPlayer: type: #Number!

Item was changed:
  ----- Method: Viewer>>initialize (in category 'initialization') -----
  initialize
  	super initialize.
+ 	self useRoundedCornersInEtoys.
+ 	self hResizing: #spaceFill; vResizing: #shrinkWrap.
+ 	self listDirection: #topToBottom.
+ 	self cellPositioning: #topLeft!
- 	self useRoundedCorners.
- 	self hResizing: #shrinkWrap; vResizing: #shrinkWrap.!

Item was changed:
  ----- Method: Viewer>>overlapsAnyPhrase (in category 'special phrases') -----
  overlapsAnyPhrase
  	"Answer a conjured-up overlaps phrase in classic tile"
  
+ 	^ self conjuredUpPhraseWithOperator: #overlapsAny:!
- 	| outerPhrase |
- 	outerPhrase := PhraseTileMorph new 
- 				setOperator: #+
- 				type: #Boolean
- 				rcvrType: #Player
- 				argType: #Player.	"temp dummy"
- 	(outerPhrase submorphs second) delete.	"operator"
- 	outerPhrase addMorphBack: (TileMorph new setOperator: #overlapsAny:).
- 	(outerPhrase submorphs second) goBehind.	"Make it third"
- 	outerPhrase submorphs last addMorph: scriptedPlayer tileToRefer.
- 	^outerPhrase!

Item was changed:
  ----- Method: Viewer>>overlapsPhrase (in category 'special phrases') -----
  overlapsPhrase
+ 	"Answer a conjured-up overlaps phrase in classic tiles."
- 	"Answer a conjured-up overlaps phrase in classic tile"
  
+ 	^ self conjuredUpPhraseWithOperator:  #overlaps:!
- 	| outerPhrase |
- 	outerPhrase := PhraseTileMorph new 
- 				setOperator: #+
- 				type: #Boolean
- 				rcvrType: #Player
- 				argType: #Player.	"temp dummy"
- 	(outerPhrase submorphs second) delete.	"operator"
- 	outerPhrase addMorphBack: (TileMorph new setOperator: #overlaps:).
- 	(outerPhrase submorphs second) goBehind.	"Make it third"
- 	outerPhrase submorphs last addMorph: scriptedPlayer tileToRefer.
- 	^outerPhrase!

Item was changed:
  ----- Method: Viewer>>patchUphillPhrase (in category 'special phrases') -----
  patchUphillPhrase
  
  	| outerPhrase upHill |
  	outerPhrase := PhraseTileMorph new 
  				setOperator: #+
  				type: #Number
  				rcvrType: #Player
  				argType: #Color.	"temp dummy"
  	(outerPhrase submorphs second) delete.	"operator"
  	(outerPhrase submorphs second) delete.	"color"
+ 	upHill _ TileCommandWithArgumentMorph newKedamaGetUpHillTile.
+ 	upHill setArgumentDefaultTo: (scriptedPlayer defaultPatchPlayer).
- 	upHill := KedamaUpHillTile new.
- 	upHill setPatchDefaultTo: (scriptedPlayer defaultPatchPlayer).
  	outerPhrase addMorphBack: upHill.
  	^outerPhrase.
  !

Item was changed:
  ----- Method: Viewer>>patchValuePhrase (in category 'special phrases') -----
  patchValuePhrase
  
  	| outerPhrase getTile |
  	outerPhrase := PhraseTileMorph new 
  				setOperator: #+
  				type: #Number
  				rcvrType: #Player
  				argType: #Color.	"temp dummy"
  	(outerPhrase submorphs second) delete.	"operator"
  	(outerPhrase submorphs second) delete.	"color"
+ 	getTile _ TileCommandWithArgumentMorph newKedamaGetPatchValueTile.
+ 	getTile setArgumentDefaultTo: (scriptedPlayer defaultPatchPlayer).
- 	getTile := KedamaGetPixelValueTile new.
- 	getTile setPatchDefaultTo: (scriptedPlayer defaultPatchPlayer).
  	outerPhrase addMorphBack: getTile.
  	^outerPhrase!

Item was changed:
  ----- Method: Viewer>>seesColorPhrase (in category 'special phrases') -----
  seesColorPhrase
  	"In classic tiles, answer a complete phrase that represents the seesColor test"
  
  	| outerPhrase seesColorTile |
  	outerPhrase := PhraseTileMorph new 
  				setOperator: #+
  				type: #Boolean
  				rcvrType: #Player
  				argType: #Color.	"temp dummy"
  	"Install (ColorSeerTile new) in middle position"
  	(outerPhrase submorphs second) delete.	"operator"
  	seesColorTile := TileMorph new setOperator: #seesColor:.
  	outerPhrase addMorphBack: seesColorTile.
  	(outerPhrase submorphs second) goBehind.	"Make it third"
+ 	"	selfTile _ self tileForSelf bePossessive.	Done by caller.
- 	"	selfTile := self tileForSelf bePossessive.	Done by caller.
  	selfTile position: 1.
  	outerPhrase firstSubmorph addMorph: selfTile.
  "
+ 	outerPhrase submorphs last addMorph: (ColorTileMorph new showPalette: false;
+ 				typeColor: (ScriptingSystem colorForType: #Color); yourself).
- 	outerPhrase submorphs last addMorph: (ColorTileMorph new 
- 				typeColor: (ScriptingSystem colorForType: #Color)).
  	^outerPhrase!

Item was changed:
  ----- Method: Viewer>>touchesAPhrase (in category 'special phrases') -----
  touchesAPhrase
+ 	"Answer a conjured-up touchesA phrase in classic tiles."
- 	"Answer a conjured-up touchesA phrase in classic tile"
  
+ 	^ self conjuredUpPhraseWithOperator: #touchesA:!
- 	| outerPhrase |
- 	outerPhrase := PhraseTileMorph new 
- 				setOperator: #+
- 				type: #Boolean
- 				rcvrType: #Player
- 				argType: #Player.	"temp dummy"
- 	(outerPhrase submorphs second) delete.	"operator"
- 	outerPhrase addMorphBack: (TileMorph new setOperator: #touchesA:).
- 	(outerPhrase submorphs second) goBehind.	"Make it third"
- 	outerPhrase submorphs last addMorph: scriptedPlayer tileToRefer.
- 	^outerPhrase!

Item was changed:
  ----- Method: Viewer>>turtleOfPhrase (in category 'special phrases') -----
  turtleOfPhrase
  
  	| outerPhrase getTile |
  	outerPhrase := PhraseTileMorph new 
  				setOperator: #+
  				type: #Player
  				rcvrType: #Player
  				argType: #Color.	"temp dummy"
  	(outerPhrase submorphs second) delete.	"operator"
  	(outerPhrase submorphs second) delete.	"color"
+ 	getTile _ TileCommandWithArgumentMorph newKedamaGetTurtleOfTile.
- 	getTile := KedamaTurtleOfTile new.
  	outerPhrase addMorphBack: getTile.
  	^outerPhrase!

Item was added:
+ AlignmentMorph subclass: #ViewerEntry
+ 	instanceVariableNames: 'helpPane'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Scripting Tiles'!

Item was added:
+ ----- Method: ViewerEntry>>codePaneMenu:shifted: (in category 'menu') -----
+ codePaneMenu: aMenu shifted: shifted
+ 	^ aMenu 
+ 		labels: 'menu
+ eventually
+ will
+ be
+ useful'
+ 		lines: #(1)
+ 		selections: #(beep flash beep flash beep)!

Item was added:
+ ----- Method: ViewerEntry>>contents:notifying: (in category 'contents') -----
+ contents: c notifying: k
+ 	"later, spruce this up so that it can accept input such as new method source"
+ 	| info |
+ 	(info _ self userSlotInformation)
+ 		ifNotNil:
+ 			[info documentation: c.
+ 			^ true].
+ 	Beeper beep.
+ 	^ false!

Item was added:
+ ----- Method: ViewerEntry>>contentsSelection (in category 'contents') -----
+ contentsSelection
+ 	"Not well understood why this needs to be here!!"
+ 	^ 1 to: 0!

Item was added:
+ ----- Method: ViewerEntry>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color
+ 		r: 1.0
+ 		g: 0.985
+ 		b: 0.985!

Item was added:
+ ----- Method: ViewerEntry>>entryType (in category 'access') -----
+ entryType
+ 	^ self viewerRow entryType!

Item was added:
+ ----- Method: ViewerEntry>>initialize (in category 'initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ 	super initialize.
+ ""
+ 	self layoutInset: 0!

Item was added:
+ ----- Method: ViewerEntry>>playerBearingCode (in category 'access') -----
+ playerBearingCode
+ 	^ owner owner scriptedPlayer!

Item was added:
+ ----- Method: ViewerEntry>>slotName (in category 'slot') -----
+ slotName
+ 	"Assuming the receiver represents a slot, return its name"
+ 
+ 	^  self viewerRow elementSymbol!

Item was added:
+ ----- Method: ViewerEntry>>userSlotInformation (in category 'slot') -----
+ userSlotInformation
+ 	"If the receiver represents a user-defined slot, then return its info; if not, retun nil"
+ 	| aSlotName info |
+ 	((self entryType == #systemSlot) or: [self entryType == #userSlot])
+ 		ifFalse:
+ 			[^ nil].
+ 	aSlotName _ self slotName.
+ 	^ ((info _ self playerBearingCode slotInfo) includesKey: aSlotName)
+ 		ifTrue:
+ 			[info at: aSlotName]
+ 		ifFalse:
+ 			[nil]!

Item was added:
+ ----- Method: ViewerEntry>>viewerRow (in category 'access') -----
+ viewerRow
+ 	"Answer the ViewerRow object, that contains the controls and the phraseTile"
+ 	^ submorphs first!

Item was added:
+ ----- Method: ViewerFlapTab>>beingOpened: (in category '*Etoys-Squeakland-accessing') -----
+ beingOpened: aBoolean
+ 
+ 	beingOpened _ aBoolean.
+ !

Item was added:
+ ----- Method: ViewerFlapTab>>lazyUnhibernate (in category '*Etoys-Squeakland-transition') -----
+ lazyUnhibernate
+ 	"recreate my viewer"
+ 
+ 	| wasShowing viewer |
+ 	referent ifNotNil: [(referent findA: Viewer) ifNotNil: [beingOpened := false. ^self]].
+ 	beingOpened == true ifTrue: [^ self].
+ 	beingOpened := true.
+ 	wasShowing := flapShowing.
+ 	"guard against not-quite-player-players"
+ 	viewer := ((scriptedPlayer respondsTo: #costume) 
+ 				and: [scriptedPlayer costume isMorph]) 
+ 					ifTrue: [self presenter viewMorph: scriptedPlayer costume]
+ 					ifFalse: [self presenter viewObjectDirectly: scriptedPlayer]. 
+ 	wasShowing ifFalse: [self hideFlap].
+ 	beingOpened := false.
+ 	^viewer!

Item was added:
+ ----- Method: ViewerLine>>addCommandFeedback: (in category '*Etoys-Squeakland-slot') -----
+ addCommandFeedback: evt
+ 	"Add screen feedback showing what would be torn off in a drag"
+ 
+ 	| aMorph |
+ 	aMorph _ RectangleMorph new bounds: ((submorphs third topLeft - (2 at 1)) corner: (submorphs last bottomRight) + (2 at 1)).
+ 	aMorph beTransparent; borderWidth: 2; borderColor: ScriptingSystem commandFeedback; lock.
+ 	ActiveWorld addHighlightMorph: aMorph for: nil!

Item was changed:
  ----- Method: ViewerLine>>addGetterFeedback (in category 'slot') -----
  addGetterFeedback
  	"Add feedback during mouseover of a getter"
  
  	| aMorph endMorph |
+ 	
+ 	endMorph _
+ 		(#(touchesA: #seesColor: #overlaps: color:sees: overlapsAny: bearingTo: bearingFrom: distanceToPlayer:) includes: self elementSymbol)
- 	endMorph :=
- 		(#(touchesA: #seesColor: #overlaps:) includes: self elementSymbol)
  			ifTrue:
+ 				[submorphs seventh]
- 				[submorphs eighth]
  			ifFalse:
+ 				[submorphs fifth].
+ 	aMorph _ RectangleMorph new bounds: ((submorphs third topLeft - (2 at 1)) corner: ((endMorph right  @ submorphs third bottom)  + (2 at 1))).
+ 	aMorph beTransparent; borderWidth: 2; borderColor: ScriptingSystem getterFeedback; lock.
+ 	ActiveWorld addHighlightMorph: aMorph for: nil.
- 				[submorphs sixth].
- 	aMorph := RectangleMorph new useRoundedCorners bounds: ((submorphs fourth topLeft - (2 @ -1)) corner: (endMorph bottomRight + (2 @ -1))).
- 	aMorph beTransparent; borderWidth: 2; borderColor: (Color r: 1.0 g: 0.355 b: 0.839); lock.
- 	aMorph setProperty: #highlight toValue: true.
- 	ActiveWorld addMorphFront: aMorph
  
  "
  Color fromUser (Color r: 1.0 g: 0.355 b: 0.839)
  "!

Item was changed:
  ----- Method: ViewerLine>>addSetterFeedback (in category 'slot') -----
  addSetterFeedback
  	"Add screen feedback showing what would be torn off to make a setter"
  
  	| aMorph |
+ 	aMorph _ RectangleMorph new bounds: ((submorphs third topLeft - (2 at 1)) corner: ((submorphs last right  @ submorphs third bottom)  + (2 at 1))).
+ 	aMorph beTransparent; borderWidth: 2; borderColor: ScriptingSystem setterFeedback; lock.
+ 	ActiveWorld addHighlightMorph: aMorph for: nil!
- 	aMorph := RectangleMorph new bounds: ((submorphs fourth topLeft - (2 at 1)) corner: (submorphs last bottomRight) + (2 at 0)).
- 	aMorph useRoundedCorners; beTransparent; borderWidth: 2; borderColor: (Color r: 1.0 g: 0.548 b: 0.452); lock.
- 	aMorph setProperty: #highlight toValue: true.
- 	ActiveWorld addMorphFront: aMorph!

Item was changed:
  ----- Method: ViewerLine>>removeHighlightFeedback (in category 'slot') -----
  removeHighlightFeedback
  	"Remove any existing highlight feedback"
  
+ 	ActiveWorld removeHighlightFeedback.
+ !
- 	(ActiveWorld submorphs select: [:m | m hasProperty: #highlight]) do:
- 		[:m | m delete]!

Item was added:
+ AlignmentMorph subclass: #ViewerRow
+ 	instanceVariableNames: 'elementSymbol'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Etoys-Scripting Tiles'!

Item was added:
+ ----- Method: ViewerRow>>elementSymbol (in category 'access') -----
+ elementSymbol
+ 	^ elementSymbol!

Item was added:
+ ----- Method: ViewerRow>>elementSymbol: (in category 'access') -----
+ elementSymbol: aSymbol
+ 	elementSymbol _ aSymbol!

Item was added:
+ ----- Method: ViewerRow>>entryType (in category 'access') -----
+ entryType
+ 	"Answer one of: #systemSlot #userSlot #systemScript #userScript"
+ 
+ 	^ self playerBearingCode elementTypeFor: elementSymbol vocabulary: self currentVocabulary!

Item was added:
+ ----- Method: ViewerRow>>initialize (in category 'initialization') -----
+ initialize
+ 	super initialize.
+ 	self layoutInset: 1!

Item was added:
+ ----- Method: ViewerRow>>playerBearingCode (in category 'access') -----
+ playerBearingCode
+ 	^ owner playerBearingCode!

Item was added:
+ ----- Method: Vocabulary class>>typeChoicesForUserVariables (in category '*Etoys-Squeakland-type vocabularies') -----
+ typeChoicesForUserVariables
+ 	"Answer a list of all user-choosable value types for variables."
+ 
+ 	| aList |
+ 	aList := #(Boolean Color CustomEvents Graphic  Number Patch Player Point ScriptName Sound String) asOrderedCollection.
+ 	(ActiveWorld notNil and:  [ActiveWorld isKedamaPresent not]) ifTrue:
+ 		[aList remove: #Patch ifAbsent: []].
+ 	Preferences allowEtoyUserCustomEvents ifFalse: [aList remove: #CustomEvents ifAbsent: []].
+ 	^ aList asSortedArray
+ 
+ "
+ Vocabulary typeChoicesForUserVariables
+ "!

Item was added:
+ ----- Method: Vocabulary>>allUntranslatedDocumentations (in category '*Etoys-Squeakland-queries') -----
+ allUntranslatedDocumentations
+ 	^ methodInterfaces
+ 		collect: [:m | m untranslatedHelpMessage]!

Item was added:
+ ----- Method: Vocabulary>>allUntranslatedWordings (in category '*Etoys-Squeakland-queries') -----
+ allUntranslatedWordings
+ 	^ methodInterfaces keys asSortedCollection collect: [:sel |
+ 		(methodInterfaces at: sel) untranslatedWording]!

Item was added:
+ EllipseMorph subclass: #WatchMorph
+ 	instanceVariableNames: 'fontName cColor handsColor romanNumerals antialias'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Demo'!
+ 
+ !WatchMorph commentStamp: '<historical>' prior: 0!
+ This class is a representation of a watch.
+ The labels' font is changeble. Labels' font size increase or decrease when resizing me.
+ 
+ WatchMorph new openInWorld
+ (WatchMorph fontName: 'ComicPlain' bgColor: Color transparent centerColor: Color transparent) openInWorld		" transparent "
+ (WatchMorph fontName: 'ComicBold' bgColor: Color white centerColor: Color black) openInWorld
+ 
+ Structure:
+ 	fontName		String -- the labels' font name
+ 	cColor			Color -- center color
+ 	handsColor		Color
+ 	romanNumerals	Boolean
+ 	antialias		Boolean!

Item was added:
+ ----- Method: WatchMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	"Answer a description for use in parts bins."
+ 
+ 	^ self partName:	'Clock' translatedNoop
+ 		categories:		#('Just for Fun')
+ 		documentation:	'An analog clock face' translatedNoop!

Item was added:
+ ----- Method: WatchMorph class>>fontName:bgColor:centerColor: (in category 'as yet unclassified') -----
+ fontName: aString bgColor: aColor centerColor: otherColor
+ 	^ self new
+ 		fontName: aString;
+ 		color: aColor;
+ 		centerColor: otherColor!

Item was added:
+ ----- Method: WatchMorph>>addCustomMenuItems:hand: (in category 'menus') -----
+ addCustomMenuItems: aMenu hand: aHandMorph
+ 	"Add morph-specific items to the given menu which was invoked by the given hand."
+ 
+ 	super addCustomMenuItems: aMenu hand: aHandMorph.
+ 	aMenu addLine.
+ 	aMenu addUpdating: #romanNumeralString action: #toggleRoman.
+ 	aMenu addUpdating: #antiAliasString action: #toggleAntialias.
+ 	aMenu addLine.
+ 	aMenu add: 'change font...' translated action: #changeFont.
+ 	aMenu balloonTextForLastItem: 'Allows you to change the font used to display the numbers.' translated.
+ 	aMenu add: 'change hands color...' translated action: #changeHandsColor.
+ 	aMenu balloonTextForLastItem: 'Allows you to specify a new color for the hands of the watch.  Note that actual *watch* color can be changed simply by using the halo''s recoloring handle.' translated.
+ 	aMenu add: 'change center color...' translated action: #changeCenterColor.
+ 	aMenu balloonTextForLastItem: 'Allows you to specify a new color to be used during PM hours for the center portion of the watch; during AM hours, a lighter shade of the same color will be used.' translated.!

Item was added:
+ ----- Method: WatchMorph>>antiAliasString (in category 'menus') -----
+ antiAliasString
+ 	^ (antialias
+ 		ifTrue: ['<on>']
+ 		ifFalse: ['<off>'])
+ 		, 'anti-aliasing' translated!

Item was added:
+ ----- Method: WatchMorph>>antialias: (in category 'accessing') -----
+ antialias: aBoolean
+ 	antialias _ aBoolean!

Item was added:
+ ----- Method: WatchMorph>>centerColor: (in category 'accessing') -----
+ centerColor: aColor
+ 	"Set the center color as indicated; map nil into transparent"
+ 
+ 	cColor _ aColor ifNil: [Color transparent]!

Item was added:
+ ----- Method: WatchMorph>>changeCenterColor (in category 'menus') -----
+ changeCenterColor
+ 	"Let the user change the color of the center of the watch"
+ 
+ 	ColorPickerMorph new
+ 		choseModalityFromPreference;
+ 		sourceHand: self activeHand;
+ 		target: self;
+ 		selector: #centerColor:;
+ 		originalColor: self color;
+ 		putUpFor: self near: self fullBounds!

Item was added:
+ ----- Method: WatchMorph>>changeFont (in category 'menus') -----
+ changeFont
+ 
+ 	self fontName: ((SelectionMenu labelList: StrikeFont familyNames
+ 							selections: StrikeFont familyNames) startUp
+ 					ifNil: [^ self])!

Item was added:
+ ----- Method: WatchMorph>>changeHandsColor (in category 'menus') -----
+ changeHandsColor
+ 	"Let the user change the color of the hands of the watch."
+ 
+ 	ColorPickerMorph new
+ 		choseModalityFromPreference;
+ 		sourceHand: self activeHand;
+ 		target: self;
+ 		selector: #handsColor:;
+ 		originalColor: self color;
+ 		putUpFor: self near: self fullBounds!

Item was added:
+ ----- Method: WatchMorph>>createLabels (in category 'nil') -----
+ createLabels
+ 
+ 	| numeral font h r |
+ 	self removeAllMorphs.
+ 	font _ StrikeFont familyName: fontName size: (h _ self height min: self width)//8.
+ 	r _ 1.0 - (1.4 * font height / h).
+ 	1 to: 12 do:
+ 		[:hour |
+ 		numeral _ romanNumerals
+ 			ifTrue: [#('I' 'II' 'III' 'IV' 'V' 'VI' 'VII' ' VIII' 'IX' 'X' 'XI' 'XII') at: hour]
+ 			ifFalse: [hour asString].
+ 		self addMorphBack: ((StringMorph contents: numeral font: font emphasis: 1)
+ 			center: (self radius: r hourAngle: hour)) lock].
+ !

Item was added:
+ ----- Method: WatchMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ "answer the default color/fill style for the receiver"
+ 	^ Color green!

Item was added:
+ ----- Method: WatchMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas
+ 	"Draw the watch on the given canvas"
+ 
+ 	| pHour pMin pSec time centerColor |
+ 	time _ Time now.
+ 	pHour _ self radius: 0.6 hourAngle: time hours + (time minutes/60.0).
+ 	pMin _ self radius: 0.72 hourAngle: (time minutes / 5.0).
+ 	pSec _ self radius: 0.8 hourAngle: (time seconds / 5.0).
+ 	centerColor _ cColor
+ 		ifNil:
+ 			[Color transparent]
+ 		ifNotNil:
+ 			[time hours < 12
+ 				ifTrue: [cColor muchLighter]
+ 				ifFalse: [cColor]].
+ 
+ 	antialias ifTrue:
+ 		[aCanvas asBalloonCanvas
+ 			aaLevel: 4;
+ 			drawOval: (bounds insetBy: borderWidth // 2 + 1) color: self fillStyle
+ 				borderWidth: borderWidth borderColor: borderColor;
+ 			drawOval: (bounds insetBy: self extent*0.35) color: centerColor
+ 				borderWidth: 0 borderColor: Color black;
+ 			drawPolygon: {self center. pHour}
+ 				color: Color transparent borderWidth: 3 borderColor: handsColor;
+ 			drawPolygon: {self center. pMin}
+ 				color: Color transparent borderWidth: 2 borderColor: handsColor;
+ 			drawPolygon: {self center. pSec}
+ 				color: Color transparent borderWidth: 1 borderColor: handsColor]
+ 		ifFalse:
+ 			[super drawOn: aCanvas.
+ 			aCanvas
+ 				fillOval: (bounds insetBy: self extent*0.35) color: centerColor;
+ 				line: self center to: pHour width: 3 color: handsColor;
+ 				line: self center to: pMin width: 2 color: handsColor;
+ 				line: self center to: pSec width: 1 color: handsColor]
+ !

Item was added:
+ ----- Method: WatchMorph>>extent: (in category 'geometry') -----
+ extent: newExtent
+ 
+ 	super extent: newExtent.
+ 	self createLabels!

Item was added:
+ ----- Method: WatchMorph>>fontName: (in category 'accessing') -----
+ fontName: aString
+ 
+ 	fontName _ aString.
+ 	self createLabels!

Item was added:
+ ----- Method: WatchMorph>>handsColor: (in category 'accessing') -----
+ handsColor: aColor
+ 
+ 	handsColor := aColor!

Item was added:
+ ----- Method: WatchMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 	super initialize.
+ 	""
+ 
+ 	self handsColor: Color red.
+ 	self centerColor: Color gray.
+ 	romanNumerals _ false.
+ 	antialias _ false.
+ 	fontName _ 'NewYork'.
+ 	self extent: 130 @ 130.
+ 	self start!

Item was added:
+ ----- Method: WatchMorph>>radius:hourAngle: (in category 'private') -----
+ radius: unitRadius hourAngle: hourAngle
+ 	"unitRadius goes from 0.0 at the center to 1.0 on the circumference.
+ 	hourAngle runs from 0.0 clockwise around to 12.0 with wrapping."
+ 
+ 	^ self center + (self extent * (Point r: 0.5 * unitRadius
+ 									degrees: hourAngle * 30.0 - 90.0)).!

Item was added:
+ ----- Method: WatchMorph>>romanNumeralString (in category 'menus') -----
+ romanNumeralString
+ 	"Answer a string governing the roman-numerals checkbox"
+ 	^ (romanNumerals
+ 		ifTrue: ['<on>']
+ 		ifFalse: ['<off>'])
+ 		, 'roman numerals' translated!

Item was added:
+ ----- Method: WatchMorph>>step (in category 'stepping and presenter') -----
+ step
+ 
+ 	self changed.!

Item was added:
+ ----- Method: WatchMorph>>toggleAntialias (in category 'menus') -----
+ toggleAntialias
+ 	antialias _ antialias not!

Item was added:
+ ----- Method: WatchMorph>>toggleRoman (in category 'menus') -----
+ toggleRoman
+ 
+ 	romanNumerals _ romanNumerals not.
+ 	self createLabels!

Item was added:
+ ----- Method: WatcherWrapper>>burnishForReplacing (in category '*Etoys-Squeakland-copying') -----
+ burnishForReplacing
+ 	"Final appearance modifications before the receiver is inserted as a replacement for an earlier version of the watcher.  This is a hook so that the FollowingWatcher has a chance to get its fonts right."!

Item was added:
+ ----- Method: WatcherWrapper>>detailedWatcherColor (in category '*Etoys-Squeakland-initialization') -----
+ detailedWatcherColor
+ 	"Answer the color to use for detailed watcher."
+ 
+ 	^  (Color r: 0.508 g: 0.663 b: 1.0)!

Item was changed:
  ----- Method: WatcherWrapper>>fancyForPlayer:getter: (in category 'initialization') -----
  fancyForPlayer: aPlayer getter: aGetter 
  	"build a labeled readout"
  	| aColor aLabel |
  	self buildForPlayer: aPlayer getter: aGetter.
+ 	aColor := self detailedWatcherColor.
- 	aColor := Color
- 				r: 0.387
- 				g: 0.581
- 				b: 1.0.
  	aLabel := StringMorph contents: variableName translated , ' = ' font: ScriptingSystem fontForTiles.
  	aLabel setProperty: #watcherLabel toValue: true.
  	self addMorphFront: aLabel.
  	self addMorphFront: (aPlayer tileReferringToSelf borderWidth: 0;
  			 layoutInset: 4 @ 0;
  			 typeColor: aColor;
  			 color: aColor;
  			 bePossessive)!

Item was added:
+ ----- Method: WatcherWrapper>>getter (in category '*Etoys-Squeakland-accessing') -----
+ getter
+ 	"Answer the selector that serves as the getter for this watcher."
+ 
+ 	^  self valueOfProperty: #getter ifAbsent: [Utilities getterSelectorFor: variableName]!

Item was changed:
  ----- Method: WatcherWrapper>>justGrabbedFrom: (in category 'accessing') -----
  justGrabbedFrom: formerOwner
+ 	"The receiver was just grabbed from its former owner and is now attached to the hand."
- 	"An attempt to make these guys easier to involve in tile scripting.  But in the end too strange, so for the moment the active ingredients commented out"
  
+ 	(submorphs select: [:m | m isTileMorph]) do:
+ 		[:m | m hidePopArrows].
- "	self center: ActiveHand position.
- 	self left: ActiveHand position x."
- 
  	super justGrabbedFrom: formerOwner!

Item was added:
+ ----- Method: WatcherWrapper>>prospectiveReplacement (in category '*Etoys-Squeakland-copying') -----
+ prospectiveReplacement
+ 	"Answer another watcher of the same class which will serve as the replacement for the receiver.  This is used when the whole apparatus needs to be rebuilt after, for example, a type change or a name change."
+ 
+ 	| replacement |
+ 	replacement := self class new.
+ 	replacement position: self position.
+ 	^ replacement!

Item was changed:
  ----- Method: WatcherWrapper>>reconstituteName (in category 'updating') -----
  reconstituteName
  	"Reconstitute the external name of the receiver"
  
  	variableName ifNotNil:
  		[self setNameTo: ('{1}''s {2}' translated format: {player externalName. variableName translated}).
+ 		(self submorphWithProperty: #watcherLabel) ifNotNilDo:
+ 			[:aLabel | aLabel contents: variableName asString translated, ' = ']]!
- 		(self submorphWithProperty: #watcherLabel) ifNotNil:
- 			[:aLabel | aLabel contents: variableName asString, ' = ']]!

Item was added:
+ ----- Method: WatcherWrapper>>variableName (in category '*Etoys-Squeakland-accessing') -----
+ variableName
+ 	"Answer the name of the variable being watched."
+ 
+ 	^ variableName!

Item was added:
+ ----- Method: WaveEditor>>buttonName:action: (in category '*Etoys-Squeakland-initialization') -----
+ buttonName: aString action: aSymbol
+ 	"Create a button with the given label and action selector, and answer it."
+ 
+ 	^ SimpleButtonMorph new
+ 		target: self;
+ 		label: aString font: ScriptingSystem fontForEToyButtons;
+ 		actionSelector: aSymbol!

Item was added:
+ RectangleMorph subclass: #WebCamMorph
+ 	instanceVariableNames: 'camNum camIsOn frameExtent displayForm resolution useFrameSize captureDelayMs'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-MorphicExtras-WebCam'!
+ 
+ !WebCamMorph commentStamp: '<historical>' prior: 0!
+ INTRODUCTION
+ =========
+ 
+ WebCamMorph together with CameraPlugin (originally from MIT Scratch) provides an easy and cross platform way to use webcam input in Squeak and Etoys. The first version has been created specifically with Etoys in mind. To view a live feed simply drag a "WebCam" tile from the "WebCam" category in the objects tool. Open up a viewer on the morph and display the "camera settings" category to explore the following basic settings:
+ 
+ 	"camera is on": turn the camera on/off.
+ 
+ 	"camera number": usually the default of "1" is ok but if you have more than one camera connected then adjust between 1 and 9 for other instances of WebCamMorph.
+ 
+ 	"max fps": leave as is for now. It is unusual for webcams to capture at higher than 30fps. See later for further explanation of how fps is controlled.
+ 
+ 	"actual fps": read-only. Indicates the actual fps being achieved which can depend significantly on lighting conditions and capture resolution...
+ 
+ 	"resolution": webcams can have a range of resolutions but for simplicity three are supported: "low" (160x120), "medium" (320x240) and "high" (640x480). Adjust in good lighting to see if "actual fps" increases. 
+ 
+ 	"use frame size": the resolution used for capturing can differ from the resolution used for display. If this setting is true then WebCamMorph is resized to match the camera resolution. If false then you are free to resize it however you want (via the "resize" halo button, use shift to preserve aspect ratio)
+ 
+ 
+ Beyond viewing a live feed WebCamMorph has been designed to support different uses including simple effects, time-lapse photography, stop-motion animation, character recognition, motion detection and more complex processing of every frame for feature detection. The following information is to help you understand how and why WebCamMorph operates so you can adjust it for your particular needs.
+ 
+ 
+ "FRAMES PER SECOND", LIGHTING & CAMERA RESOLUTION
+ ==================================
+ 
+ The maximum possible frame rate depends on many factors, some of which are outside of our control. Frame rates differ between cameras and usually depend significantly on chosen resolution and lighting conditions. To ensure a balance between capturing every available frame and keeping everything else responsive, WebCamMorph dynamically adjusts the delay between capturing one frame and the next (does not apply when in "manual capture" mode, see later). 
+ 
+ WebCams often include automatic compensation for lighting conditions. In low lighting it takes significantly more time for the camera to get a picture than it does in good lighting conditions. For example 30fps may be possible with good lighting compared to 7fps in low lighting. So for best capture rates ensure you have good lighting!! 
+ 
+ Cameras have a "native" resolution at which frame rates are usually better than for other resolutions. Note though that the native resolution might be *higher*
+ than the *minimum* resolution available. It pays to experiment with different resolutions to find which one results in the highest frame rate. Use good lighting conditions when experimenting with resolutions.
+ 
+ 
+ "MANUAL CAPTURE" MODE
+ ===============
+ 
+ In simply usage WebCamMorph automatically captures a frame and displays it. To support Etoys scripting a "manual capture" mode is provided where you or your script determines when to capture, when to apply effects (or not) and when to update the display. In between these steps you can do anything you want. Note that frames rates will be lower than that in automatic capture mode and that "skip frames" (described next) will need adjusting at very low capture rates.
+ 
+ Tip: In manual mode the camera can be turned off. It will be turned on automatically when required and return to it's previous state after a frame has been captured. For capture periods of five seconds or more turning the camera off may save power, which can especially useful when running off batteries. For smaller periods leaving the camera on will avoid some delays and could help speed up webcam related scripts.
+ 
+ 
+ "SKIP FRAMES"
+ ========
+ 
+ Webcams and their drivers are typically designed for streaming live video and use internal buffering to help speed things up. At low capture rates the picture can appear to lag real-time because what you see is the next available buffer not the *latest* buffer. So for example if you capture a frame every ten seconds and there are three buffers being used then what you actually see may be thirty seconds old. We have little/no control over the number of buffers used and the actual number can vary between cameras and under different circumstances for the same camera. "skip frames" is provided to compensate for buffering so increase it when doing "manual" capturing until you see what you expect to see. Typically a setting of 8 is enough but I have had to use 20 with one particular camera in low lighting.
+ 
+ 
+ "SNAPSHOTS"
+ ========
+ 
+ Where as "capturing" is the process of getting an image from the Camera into Squeak/Etoys, a "snapshot" preserves whatever is currently displayed (which may be the captured image after effects have been applied). To store snapshots you need to designate a "holder" which at the moment can be either a "holder" morph or a "movie" morph. Create one of these before proceeding. To assign a holder open up a viewer for WebCamMorph, display the "snapshot" category and click in the box at the right of the entry called "snapshot holder". The cursor will now resemble a cross-hair and can be clicked on the target holder/movie morph. To take a single snapshot at any time click (!!) on the left of "take snapshot". In auto-capture mode WebCamMorph can also be set to take multiple consecutive snapshots . First, before turning the camera on, set a sensible limit using "snapshot limit" (to avoid using all the computers memory) then set "auto snapshot" to true. When the camera is next turned on then snapshots are taken for every frame until "snapshot limit" becomes zero. "snapshot limit" is automatically decremented but not reset to avoid problems (although you are free to reset it manually or via a script).
+ 
+ 
+ "EFFECTS" - WIP
+ =========
+ 
+ Similar to snapshots, a holder can be designated as the "effects holder". This holder is intended to be populated with "fx" morphs (coming soon) which will operate on captured frames prior to displaying. Stay tuned ;-)
+ 
+ 
+ CLEARING SNAPSHOT & EFFECTS HOLDERS
+ =========================
+ 
+ Keeping a link to snapshot or effects holders can tie up resources even after the target holders have been deleted and are no longer visible. To ensure this does not happen designate the WebCamMorph itself as the holder (for method see "snapshots" section above).
+ 
+ 
+ COMING SOON!!
+ =========
+ 
+ - Built-in basic effects such as brightness, contrast and hue.
+ - Image "fx" morphs for effects such as those found in MIT Scratch and many other types of effects/ image processing.
+ - More snapshot options, eg, store to file
+ - Demo projects
+ 
+ !

Item was added:
+ ----- Method: WebCamMorph class>>additionsToViewerCategories (in category 'scripting') -----
+ 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."
+ 	^ #(
+ 
+ 	(#'camera' (
+ 		(slot resolution '160x120, 320x240 or 640x480' 
+ 			WebCamResolution readWrite Player getWebCamResolution Player setWebCamResolution:)
+ 		(slot cameraIsOn 'Whether the camera is on/off' Boolean readWrite Player getWebCamIsOn Player setWebCamIsOn:)
+ 		(slot useFrameSize 'Resize the player to match the camera''s frame size' 
+ 			Boolean readWrite Player getUseFrameSize Player setUseFrameSize:)
+ 		(slot lastFrame 'A player with the last frame' Player readOnly	Player getLastFrame unused unused)
+ 		))
+ )
+ !

Item was added:
+ ----- Method: WebCamMorph class>>allOff (in category 'accessing') -----
+ allOff
+ 	self allInstancesDo: [:each | each off].!

Item was added:
+ ----- Method: WebCamMorph class>>descriptionForPartsBin (in category 'parts bin') -----
+ descriptionForPartsBin
+ 	^ self
+ 		partName: 'Camera' translatedNoop
+ 		categories: {'Multimedia' translatedNoop}
+ 		documentation: 'Web camera player.' translatedNoop
+ 		sampleImageForm: self icon!

Item was added:
+ ----- Method: WebCamMorph class>>icon (in category 'parts bin') -----
+ icon
+ 	"Original file: imagecodericon.png"
+ 
+ 	^ (PNGReadWriter on: (Base64MimeConverter mimeDecodeToBytes: 
+ 'iVBORw0KGgoAAAANSUhEUgAAAEAAAABACAYAAACqaXHeAAAABmJLR0QA/wD/AP+gvaeTAAAA
+ CXBIWXMAAAsTAAALEwEAmpwYAAAAB3RJTUUH1wIECy0ZfllfzgAAAB10RVh0Q29tbWVudABD
+ cmVhdGVkIHdpdGggVGhlIEdJTVDvZCVuAAAgAElEQVR42uW7yZNsV37f9znDnTOzMrOGrPHh
+ oR7mBtAC0BPAbpJqEpQ4tNkSF3JYbdMOLWhHmOEI/wE2rFCEubFX3lgOO+wQg3bYEbQtyaRE
+ kGx2mw12kw00UOjG9F7VG+rVkDXkeO/NO57jxc33RMlaOGjvfHKRmXc4957fPHyP+Dv/zj/E
+ sdhagBYGi4MUFolFIkCCxGIRSAwIiUCCAOzynBCAQNm6uUtUWCTWSoTNUEgqdHOLfTRbCbam
+ RpFkKZ6nUQgMCmyJNGCExVpBbS3SGmorELYGSoy1CGupLUhbUloJFszyY2uohUEYS2UBarCG
+ wkgsIGyFsUZojbRGShQgmvUiEGhoFokAFFIYpBXUQiKxCGGQFuzyv0GBUGByhHARGIwpSIuS
+ dtBCGwXUGCqsUFgcjHBRtsZBUywKoqCFFBZhFIYKZfVjwhs0ippHbyix1ABIauEgLECFxCBs
+ hRVgLYBFixprGiao5VVWgMVYDQ6KZvUKg6DhKlIgl48DgUWjhEFhG7pYgRUSjcBikLJGGkuF
+ beZDkBUZ8eyalhdRlTEC0I7PxeiM3kqPoqxx3YiqzkizGLCsBC0qKaA0CCkBBcKiqBsiYxHW
+ wYoKg2iOGIm1AgtYKkrhNdIpDJYKYxWCumGlsAhbUyGRgNYIpBAI7HKxEiXA0nBWCttw2QqU
+ kA0XhUJhANlQXgiEtRgMZVkjVEpRg60LlK2Zzy6oqoLuyiZlWTKbXSAxeG5IWlRkWYanFZ52
+ QGjmkzOEgDDwwBYIYRHSRS7F3oqaGom2GqippMDaRn0NEtcajKgwVoBt2AHgILBU1Ev1NVai
+ lZCNbi8pIgQIIUFKpAGExcFihGhURAgU9rFcIFhyxzJLZmBKLscz8ioj8kOqyuBqn9n0iqLI
+ KaqS4fkdiixlc+MGV+NzHOkQ2xzX8UC7aKk4v3zIk0+sEsdX+F6EK10QAiNV857WYoWlRqNZ
+ ijxgoBF1C5ICKy1YSy0bRRXmEbMVyAopRSOyWliUACUaCXCsQUvQAqQERxq0MEghkEiUkIgq
+ BVNhASksgeuySFMUFbYqUNLB1CUtP2Rz7QlG4zPydIKQBmtKTs8Pub6+x2h6CqYkTWY8PDsE
+ BHsbW8wn51RFxWg8BGq0AFdWCCGRj5gkDA4GJcWSORIXs7zGQ+IihUQh0VaiUDi2+a2RaEmz
+ wEb3xVIJQEiLwGIBhcCKxjgKDGU5o6wsk+k5SrlEviYMutR5ChhGk3MCNyJfzFGipqoLfM9F
+ K5duu890dkGezVnkCVWdM48nbHQ3efDwIzqtNYoiazyBkCRZwqC3g5Ye2haUVi91W6JsI4VW
+ iMbjCNNwG3AaX4BFIIBqadCNhUq4SFsBoJVkabQatydFI9ZFkVOWC9phCyldhGgmSpIpR/d/
+ TLc7IJ5PUMphNitZ6WR4TkgcT5jPr1Adje8HXIwvaUc9JtNrdtc2OXr4Ma52OLs+pt/qc3Jx
+ j+2NZ5inY3ylqcuUdDFllgwpixypFIPVHYQtQEhcaowFI0xjjqWiQqKoHou6tBZhDLUQGGPB
+ SrQwGKuQ1CBKrBBIC+r1V/7WW1I0oi6URC5FvioWXF+fEkVtfO0iqUmTGXmRcXZ+iKM1ZTFD
+ Cpd7Jx8RxxMc7aNsjudFFEXCfD7m+PxjrmdD+p0+dW1oeS1m8ZjpfIhUCoVlkceMp+dEUZu8
+ WOC7HvFihrRwNTppRFsI+lEPgUQLixCWLJsihcB9ZL8AtZQOxCNpNs0ZIUGYxk3SSDcIpFrq
+ vhCicXNLmxAGEZiS+fgSCSySGKqClh/R66wSuS5aaabTM4TJOb28w+XoHoEX0o1Wmc0uOR5+
+ ylp3hyydoRHMZ1dIoBVEtPw2UNHvDMiLFN8NKPI5eRajpaTltijrnCjoMJmeU1YFQoBDSVXO
+ mUwvWSySJiCSoKRFSIEUEkfUuFhcajTNurS1zW/AEQIlNFqAVkIg5FL/xTIAMjVxnhLogNB3
+ GY/PqKuKukjprQ7otlYpyhRfubitLteTh7hSMb4+pi4yJAYpNRu9deqqwpic0+EhWvkoDKEO
+ cLXDZD5kc3eT46EhcgKm8zFrK1ucX92jHXYwVY7jKOrasN3fwFeSqqwYja65ml3Q767SUgKE
+ xRqDEBprLYgm0JG4CFmBlVgJ1jTnKmwTqFGjvvbq336rsf6NLZBCohRUZUEcT4njMdPpBVJY
+ LkZnFMWCPI1RWjKaXBEEAZur27ScFq52UBLKfMFad51FNsXVDtP4ErC4Ggb9XXbW9ji/uk8Y
+ tJjGUwLPxwiLVopeq8/V5JQsT3Edj+l8RDvq4iqP0PNBaLI8JcnGVKZmFk+IXI1GNMZcNqG6
+ xiKpEcJipUSbZQBHoz5N0G2QjftrQkstLBqLIwT9Voubm0+glWTQ26KuYm5t3+L0/A5Iw/X4
+ go3uCot0xjwZE0ZtQrdFWS6acKPKGaxs4igXR2usKZknU1yt6LU6+MrHc1xGsyGzZEw36NBy
+ QtLFGK01Hb/DbD5id32fyA3whebq4kETUdqSoki4uLjPeHrG8dk9FsUCIQRagCMMUoKWAo3C
+ txWOBEc1a9NC4gqJQqMf6bxYuj8pl+GwkHQin5dvvcTl+JyyiLi4PmGwukm3tUKxmHNycY/9
+ radJ85ittU2uhGCWXFDZnNOruzjKxdoaRzi42seRikF7jXQxYX11lSxbgKjZXbtBVWTUpiZO
+ p4RuSOD5VKagKjMQhrPRPbZWb1DnKWk6pswykmxCKwg4vbyP6wZsSkEr6oK0YAwGqJXFGNV4
+ CCtQyqCsxViJEjXq577wzbe0AC1ByiajE0qghQVrsKZGAaVJKRcJiyKl47fxPAdpJdZWTJMR
+ ZZUx6G7iSoWQNU8NnsbXktpWlFXOjY09snyBi0ucXbO3sc3xxSGB26LthjjaoaJiHDeGshNG
+ zBdzZukEsIRuQD9skS1S0sWMvExJypg4S1jr9HGlizA1i0WMIw2OUkglcaARdcEylwEl6ia5
+ w6K1oElwpEAIQ5WVuNJBWnjw8Ihuq8UiqxClYLXXo7zKuJpc0otcZsmUss4xdUboubQ9h0R7
+ YAxX8yGBdmnrkGF5wmR6xXwx4Xh0xLO7+yTzKXEWo7XDRmeNoig4m5wyjScEXR9hJL7jYUzN
+ Wtgjy2fcPvmUyIsYxZdcxRM810FYhWmvkmdj3nv4Y3Y3bjC8hhf3X6ItQyoJ5lGwbgRI0YTK
+ dY1RNdp55AaXkWBexDw4HSKVRBrLw7MjdreepBV1uJ6coZSlH4RM4xFrgU9mHKZpSpbOGE8u
+ GHR7dALNdz7+HqtRj7ossLZif3WX3zv9iEWR4GDwgogb3W3uX58QxxPSKqMfdHhgDD2/TWUW
+ hL6HwLDie8xyQ1UVTOMFpoa0mBP5GyihMLYmSSbE+RhP3aQoFtRZiuOHaAtG1djaUisLpqkv
+ NFohUb/05V99S0lw1NJ4CIGUEqEsrdAn9AMm41M67ZB2GOIKwyyZ8tz2La6nF4znVyyyBEdK
+ 7p7fIXAUW911bnQ3OZ2c4TmKk9GQMAjJ8pzQcYlCn4fXD6nKglf3X8BFIxQ8GD3kmc2bICX3
+ Lx6w0V5lu7+FsSVX0wvWW32m2RSLYbyYUpmKylTUVcE4HSMEJIuUtVaH0A1YaXVwl7GBlGJp
+ 5E2j6tgmzf43vvyrbzlS4GDR0uC7DqHjoAV0oxDqgpVul8n1OdViQTsIuD+8hyfBmgrX0fSi
+ DmkxZ5RM6YdtIsej31vhfHyKL33W2n1Oxhf0/BYPRycE2iHwAna66+xF69xYWyMUko+Gd+j4
+ LR5cnvDKzeeR1nJ69ZBaQNePaLsBtiq5jK9pBSFaCF4Y3OIyGYGtWQm7hK5GW4GWkp3+Gq5W
+ aGnRsEyYmqhXLb+1Lw1SNimxpMn4XMdyfO8+4eYWg3aIp10iUzNfzEizhLxaEAU+T63uMk5G
+ 3B7eZ6Pdp+9HjJMRq60VeoXHemeFjtNivb1K9dmfc+fihMDxuHP5gBsrm8x1yMyb4juSOxf3
+ qA0MZ5e4jiKvcrbaHS6mV3R8j74KyaqCnU6fu/MLpDVsdda4Tsa0HYdZluJhqIuctf42HjUu
+ NZ5svJsVYKyhXn5bYzGA+jtv/MpbjgRXGHwloS5ZJDMklvfvfEjkeswmlyghCTXcXN/k5d1b
+ /MmP32E+n7HZ7fP01i5SSm50VzHS8uLOPi3fI88WzNMFz6xu8PDyIVVR4TseJ7MRT3f7CCu5
+ udKjqzU/vrjLVTzm5uoAW5aMkxkv7OwDhtDxeGp1i6LKmeUJJSWOdhhEK0SeR1HmFGXBatjG
+ mhpBzVee/jwtz4UyRguL6zRBmjIlWoMSjUqov/tT33jLV+Zf6IetKRYJVZYQKknX83CEoCxm
+ FGXJs9vbpEnMiutzdPWQqlpwdHaPQMD+1ja9MGJRxmxGbZJswV/c+YDQwuX0kid7A6yjuH35
+ EMf1eXF9k9PJJVIKPro85rUbt1j12/zk7AghLWWWk9cFz/c2uTc+Z80NOLi4h9IKH8l1Nqcy
+ FdbUbLV6SGNouQ6rXoteELLiOSySmLJc0I0CsmTGLJ2xEgS4SqCUQEYSAqlwTEWVJbi2YHOl
+ jY/BGENRpjx3Y4/nt3fZ6XW4fe8Tyjpj0O7wpZv7nCcjWqGHq2CaTLkaDbl9/zYulhutDl/b
+ f44fDY/Qrssbt55jMR+x3e7ytSee4cfDB0Seyx/eeZ8vbN1AmMY/f2H7JoF06XkO2tZ8NryP
+ omIaTxFSEiI5T8b0XZdt6fLKxi55lZKbjMBx0LagymNG1+fE8TWT6TVUOapaEIkaX1kCDYEG
+ 9fd+plGB0NFoBXmaoJXA8TTClrQciawrrq6HPDHYZDqf4inBPJ3yzGCTLoLj8SVP9weIPOWJ
+ tQ3SPOeT40Oe7/fZ669wGU+Y5SkPL05JTMXh9ZCNbpcimfPj61Ne2drjfHxFUqUUZYWUlo52
+ OYvnKCFouS7D+ZhZPqfn+Pzo8pgv7ezzQm/AzY0BabYgr0u2W108a/jcYJet9grHlw8RdU1c
+ ZWyELe6e3acXBgy6XbS0uBh0IC1aCKS0hI7LeriBsDVJbNlducU7H/wAbS2yLkimV/SUxKfG
+ 1YrT4we0sfybL73Gf//n32a6WPDqzpP0gpDzMiVPZuSzmj6aOZINz8cYQ1WVzGZTtjsrSMfh
+ 8701/qvDj9jo9XhxtcNuq829yYSXNrf4zuEnfFLl/PTuk1RVzZ+ePWA9iHClpRt6mKLk0+tT
+ nt/YJjCCjIKr2Yjjy4coxyFyHZ7qrfHg9AGDlR47a2sECmorqaVF/eZf/5W3PAmuErhS4Uvw
+ lKIqM7J4xvZKl1k845PTQ165cZNeOyLwAgKt6IYO4yRhOLrki3s3+OnnX+Sz82NO59f88N4R
+ n9vd4SvPPo2rNR+f3OfW2jpPr65xd3LJ5/sbfDYe8eLaGnVdMC1yvvHs8+y1Wvzw5Jjb4wu0
+ gJ+78SQHF2eUxuC6DkVV8sbeTb564wk6QYt37n3KRhCx3+5ye3jKMJ1xEU+Y5QtCz2Oj28VW
+ OcpzeWFnB1drAtfBlRIpQf1HX/uFtxwl8ZXCU01AJIWlLhLmoyHnl+coUzOfTbl9ecbmSpfp
+ 9Tmj6RSpFVW+oBv6XM8mrGjJ87t7PLO2xsu7N/jdd7/P1mCbvEp5dvcG/+zDD3hqpcP3Tx9C
+ bZBaMZqO2dre4u//4q/w/mef8s/uHvELzz7Hz27v8cnogn9+7w43+j3+3dff4KX1DT69uGS7
+ 1eZ0MuEnl6fMFgl7q6t8/eln2Ah8Pru+xHEUu2FIoAS7vT5Swl67Rb/TphOFBK5EKnAVaGVL
+ AsdFK4FUIKyhKjI8JfA9D6UNx1dDtgZrlEXGj48PeWZjg/l0xGV8Teh6jPI5/cCnMiU7qxGz
+ i4wnb+5y93SP3/vB9/hbr77Ca6++TJol3L+8pipKBqs+f3B8j19+8XP86v5T/N4Pf8A/PbyN
+ pzWfXg55dn2Nw9E1rz9xky9tbfHkxgb/+T/5xwzTmM3EY73b5c39Z3my3eLo4Ql/cPAeZ2nM
+ zVbE3SSmF0T0eisM+h12+32kqbHSUlcLWuFK0zuwoP79L3z5rVbooaRFO5IyHiFEjSlTtK1I
+ rye0PU0r8FgUJZ4j+f6dO2z3O0SeQxLH+FJSiBrlOMRxyuDpJ5CO4tUndvj9d3/E3/u3/jbJ
+ xTnrQvPe4R2MqQlaEWeTGYFyOE+mnM1TfutXf5kbvsu//dUvcTGf8+3PPuM/+eVfpCgL/ss/
+ /iO+/sxT/Gd/829w//QMV0rKquDe+Tl3x2NOkjkvDdb5yv6TTEZXjBcJL+1ss+EqFumUzY0N
+ gkDT66+hXYHWEqUE6j/8wlfeWumvUGYpxmTMry6RWiERJNMxg0GfVhRSmop2d4W6KMjqnLwo
+ +NzNGzy1O+Dh1TXrg1XC0EeYgifX+6Aknz084fbJGT/1wrOY6yu07zFJY/74s7ucxTF//xf/
+ BhUG8oJfe+VFHM/Bk4L/6d0D/ocf/Dk73S4nSco/evcvuNHtcj6f8979Y3ZXe7xxc4+B5zZN
+ O9flZ3c2KfMCKwWfXV7wTK9HMZ/w6fU1G0HA9fiaTuDhtyKUo5tkTwh0kU6g6BK1Q9I0JS0X
+ jE8mtFsReRFT2YoHp+d4gcdaN2LF6fDMzio/vH2XP//4U9aDgBtrK5TADz7+lJYfcng15rUn
+ d/nw6IhxuuDO0T32dzfo9Xr82s0d3r13zIM0A1ey1vJ589WXKX2HoL/Kx6Mr3v7kY0ZpwtO7
+ 28yTOa+srvGzN3dZdTx29rYZXU84vb5m0G5xOZnw2pM3qdOMpzZX+fjskrVWxI/PzqiswdUe
+ sip549lnubwaobQGDK31Laraon7zi6+91e608FoBbhjgCKjqisl4Qif0CLtt1ntdopYPdU2J
+ ZTKPafkeoqrITcXO0/tMT4eUdcVsseCFZ27x4Z0jji+uEVh2Vnvo8ZTJyTntXofRdMp3Pzsi
+ Kwt+81e+Tr/fZn2wxvuf3uEff+8HLGrDRiviP/jGm1STKT+/u0XUDrl/fsHh6TllVXIj8HFt
+ zXlWshr4UJU8WOTcubzk2dU+z20OeGV3h0CARuL7EXlZ4GgXN2wvgzyDuPsn37Z5nqN9nwfH
+ x+xsbyKtxXMkWZEjtQLThMpCK6SgqbzamlmaEgUeVVlRFjlKSqJWwOX1CF9LxklCWpTsddso
+ a/B9F6kl5+MJV7OY9W6b7V6bui4ZzRPSPEMYw1WSMOi0kEKQ5hlVWRK5DspUuFqRlSWVtSRl
+ Tktpeq2IcZoQuJosy/BdtymJmWpZ3hN4rosBsBbXdXEcF2tBHz94wOdffomo2+bJm7sIAWW2
+ aNqnwmLrkqoouLy6Ip7M8H2XwdaARRyjpc/qWp+6KqmKHGkNaMlKa8DZ5RVd6eMWAu3CE1sb
+ FHlT98syQVZLViOBFgWXsxGdwKUXeJxOJnQCCH1LVizY7bq0XZ/ZYsFlkrGoa0JXgTU82fEp
+ 64pFOcLVNZHnIykItaE2FfmScIuyQKLpBiEI8FyFVAV1VaHBYkzNu+++S3dlhfXVHmEY8tY/
+ +C22tgb8tZc/xxuvf4GTHw/5H//n/41v/uLX+d6f/QV7N3c5v7hisNrl4KNP+dnXX2U6nZEl
+ Czr9DkmacvjghNB3iWdz9rc3iOcxYeTzv/z+n/Lrv/5LnE9jAlfzxMYaaZ4xTRKUUpRFTrxY
+ 0PFcitpwnZcsipJ+EFJh6Houi7JgukhZ8T08J2SyWJCVBd0oIitzlNSEWqKFZEVJpNQIAVo1
+ UlzXNcYYZJomGFvRikLe/pPv4gYBytU8/exTfPWrX6asa6q64ktffIWbT+wQrbTxIp/LqxF3
+ 795neD1io7/C//5P/4hPPj3kejzmu9//ET/zlc8zPLvk8y/c4qPb9/mLH31CVlZo3+OnvvgC
+ jtb02i1ubW9wMZkxmsckWYYFXtgasN9bYdCO2F3rE2rNahBQY+mFIcYYLBB6LnldM8sWrLci
+ Wq7LoshwpaLjB3Q9n07gEfk+SjbNXakUlqYHIaRA/cf/3q+/tbbWw0rJl7/8GlorHEexSFMW
+ acr+jV3agUddl0gpuXnzBhtrfTrtiHY7Yv+JHXY31xhs9Ol0WziOw4vP3OTw8D4vPHuTXq9D
+ aQzHD4c8c2uP1197gbt3T+ivd1jkOXGS0vYc2lHIJE3Z73eJfJd4sSApcsqixNqaeZFTVBVt
+ V4MUXMYx7TCgHfj4jmYlDKiqiq7vo6wBa6hN/ZcAHCClXC5cYu0SC/HhP/lde+vWTfxWhDX1
+ EvxksHUFtqaqmmOysSZISVN0WJaXbFVRJHPm8xgd+AS+y/jqCkeC0ppFXXE9mTa1wrUeVZkz
+ iWNOxhNWo4Ab612yLOOT0yGb7ZC8KnEd1WABlCB0HbSEO+cXrPkuQgrujkf0WhGOtRhqAsfB
+ kZBmGSuei6kqLAZHK7R2KIoCpVRTG9R62QURGGvR/W6L8Xvv4yGa/pqWWGMpFylCaTA1Siuk
+ 1gjHBSmwVckjElpjqPMMqTWzJOU0TkEI1td6lFlGnC44vxrTW2njrMRgDUcn51RAq9vh4qTi
+ 9oMTirqm8Ga4UhK5DmEUMs8LYldTFSXX44REZ1xnOW3PRXYUqbGs+i2UVtRVgVM7pFJSVzVa
+ K0ohQQry3MEYg+f7LLtj1KbBIOmyLHHjmM7Xf4FFVdJe6WCMbRYJfOePvs3+E/tsbG42RFCS
+ ujZYY1BKI7VECEEynxNWBl3VJFnOWVmhlcJ3NDtVRW2hN1glSVM64xlGSNpRwEWc0H7qFVqu
+ y8ZaH08IbF3iOy61kJRlSVlXOGnGPMt51lHUpWFcFjyztornuiilAcizHD+MKPIM7biNC6fB
+ CFjbgD2ssVR1TVUvCSCUoKxqvv0nf8w0nrO5vc0iy/GkYDadYeqaq8tLHjx8wMXVFSiFpzV7
+ T93ic8+/QJkXoBVhFGLKgjwriQIPIQRpVXI+mtHrtLgYTZglKZHrIIWkrA2TRcaiqhi0I57Y
+ HuAFAaYoKXJFssjwPJeqKBsbMhqz1elQGktqDXsrK+Rlhev5y+gOpCwxdXMMAaY2CKmQUmBs
+ I63GGqRSOFJSVBV6Po/x8gXCD7ixs4Mb+rRaIY72WOn2uB5dsbm7RZwmdFb7tPpdHh7eBWNQ
+ CoQjsXWFMVDUBuW5OJ6LsDW6VqystLm6HFEZuJwn9HcHDbBKS3zXwdGK7dUeZVmxKOdUWYFW
+ EiUleVZwnSRcpCmR55NXNZvtNnFeUCOpMWRFzTydoZVGKU26KHHdprdpRINis8ZQW6itpaoF
+ VV1SLYmhq6riahrzxBffwFeKKPAxSiEsOAKevHmToNViSwrKLEdKxc3BTiNauaEqDVjIyqZH
+ oLWmSHPKosJzNY4UbPZXuY4XVLVhOI6XZXgoqhpTG4bXMxyl8B0X13EbqBeSOE8ZxinacegG
+ bSxwleaU1uDTJGzzIsEYQ+QFRJ7G8wOWEDbk0kYVRYF2HIQQOAr0UmWsBf1wkWEqwyqayzTD
+ y0o8R9MLQgoEH3/0E2azOVVtKKqKPFvwpVdfYzIZY61FSEUQhkghWFlZ4eDDA37qq1/j9//5
+ H/L8s88xmU5IFwsmZc725hZFXXNxecGDkxOkkOwGEXs3nyCZTHj1lVf44OBDur0eH9++jbfa
+ 42R4zlbUQWxtMVhfp7SN/i7qBZ0gwpUKJSRxvqC0NaGp8bSDBVwJxixtvrV4SmAt1BZMg5dF
+ a6lYYJkWBTWQW9BWMi9qlICtW89w50//lMpUUFSs9Ve5fe+YLFsgpWx6/9cjTG0bXasb8jva
+ ZWtnl08+u8Pp2RmjdMbO9i6udrj38CEgmE0mrODw3f/zzyiLgvbagKtZQlzUHJ2fEx/fJ5vO
+ eebNN4lWVpjlOQLIyoLAcZFYyqrCSE0nCClrS2klSZriCIkUFq29JivEUFXmMRZOLKve4n/9
+ 7X9o+eiI9Z/7BSQCrSQdLyArS1wl8bSmrg3dMEAKiVCK4fmQ8/MzvvSlLyHlEolpDVVdN8Aj
+ CaZuYoisLImLnEVZkhQFSghmRQ7AXrdH6HhorRvElta8//77rN+8QVzk9MM273/wAa3eCv3V
+ VWpTN2BJa9BKsxqtYI2hrMsl0R0C18cs8ctK6UYNrG3C3iWWsDI1RVlijEHXtsZdtouU1Kz5
+ AVYIjJQNGtPU+FpjTMV3v/cOe3s32NveYmvjc7jSgqgacZICXwqKoqBaVE3kZCyhI5FGoa1h
+ ktX4vo8pMlbDkLUwQEmFkIraNNCVzu4WRV3S9X1sXbD/zC0AKtOgUR2h8LXGkZo4Swi0S2UM
+ jpTLdFcv0V8NMFYs8YFSSYy1lGXJosgwxlAvwaDYJexcW8PVIiWvKzyliRyX3/0/fo+vvPYq
+ 3V6f89GIMGoxPD9ndH2N42harYj1tXWef/55iqLA2mWvUWgq08DVXdfFYAm0ZpQmj2wUtTEs
+ irxBsVk4mc1YVBXPrK9j6pq0KOl7Lq6UXGWLpqdnK6yRRFqTVzXalmRVQcsPQEBIRWFqIlfi
+ Ok3sX1uLEA2WNsOgK0NhDY6j0MbWRFriqwYd7iiBtJKOEnRDzTd/+ivs7e02Fnxvk1tP7ZEt
+ FqSbPTprfS7OhwQtj9Zqq8Hgul4TZRnTqEZdUZYF0jisSsv0IkMAviPx1jqsaAVlxe0Hp2gp
+ eHFvq0mrS8PG+jpFmlGVBWDISsmkKPGFQNgSJSw9T9F2gybLsxZjKwIt8bVAaoHWAqFUgyY3
+ NdJqFJpFUS5dtTFoLIomtl9zHXIpaAdNMLG2tspkOicMfV7/6a/iei4Yi1ASW9fs33oaUxWN
+ blY1dZYhZPM7Sxe4WuF2WmgktrbcvbjGAiudDqHrUuU5RydDamO4ubGGpxykViRlTLooyRY5
+ YHEch2lWLHGBkmzZ3Z1VjTGTxuA7DTrFEQ5pZZq2uARbW4w1VFVFVVoqoyiARZmhBYZJUeIY
+ gy8l10WFtRDHGZVpABO+1tGZ8eYAAAbgSURBVMzjAjPLMECoHW7fuYOjNZPr6yb2X1+jqCqu
+ r6546ulnOD09pb+2ysbGBu/+/rfptNtkZUG0t8v58QkP3vsRX/nq1zgbXXH/3gPGDx/yd7/1
+ LeqqRioorUMyy9COxySeUZia0sLCGKqySdAqYxjlJUKIRmVdhe/5TNIcRzuoomn1C9HsEjHG
+ YEzd7EKhIaI0WApjyOqaaVlytVhwnWWM85zaNgjSvK6pjaUyFmMsxlo+/PCAs7MzhsMhvu9x
+ cHBAPJ1SLjJOj+/TbYf0WxGB67BIYyZpzMnlJQb49PanxLM5cVkghGQzCtkcrHPy4AG+q/G0
+ xnc0vqsQpqLlNnbAk4KW08BmXNE0c5QQBErTcX0cYfGExZMQOgppKqSpcKXBkxZfWlwBylY4
+ GLp+iPid/+6/sHxyTP/rf7MxTkKgxRInbgUtrREW+oGPsGCW+zIixwVriTxvubXG4rkuOvCR
+ vtdkklJQpilSSoypSWZzfvjwjMViQbVYsLW5yV+7eQPXbbI1qdRjY1XnJcl0gnJcsmxBXtVU
+ xjDLC4SSZFVF6DhkZUVLO3iObup+xuB7AWVVopTCcRzkMv9/JAWLvEBIQV3XTUnsLw+7hJsr
+ IaisYVY2+p0njR+tTI1EEOqSw6O7vP7Sy5hluLW4GjMajXj66adxXRetFe9/cEBVG6bTCc+/
+ 9CIW8IKAXrvNjfYK8XhOEIbNxiubo5RuKrZFQVIY4vmEyjZSV5oaiyDOcjypyGuDkRKrJHlt
+ mcUp3SiiqOtH2HfK2kK9DAeXqbDWmrTIqGuDbgLvf5kIxjbp4yNuAJTWYOrmuBKC77/3Hu8f
+ HPDZe++xt7PN1tYmF1dXhK7DYpGwe2OP7Z0dtnY3uXP7DtrV+IGLnTfz3equIE2NBJQjm6xS
+ SrQW2ArSMifJF6RlU4lSS53Xstl1JptUH0cIPCVZFBVCWAJH4zoO4hEm3Db+nqU6W5pKkS8V
+ Vmn0v7L2fyEJS2l49Mc+2jwhJaUxdNbXef6lFxEIfnh0xOt7e6jBFscXQ04ur5kol0xojk5P
+ SGYxo+mEaGfn8fzDJCEpSlwhsOMxxlgKa3GlXD67IbojBFVVUizVTwtJx9NYA5EjKYylqgrm
+ RUHXb7CL3TBAa73cySKwtsZY0ewiUQ1RkjIHaxG/89/+luXTU/pf/yX+3wzx+Hv5EY9oZ5fb
+ 1xrq/+vo/WinShwntFutJakFzS7A//tQy80bj6RVy2YniK8kEkFtDUpIXCXJ6gb6G7oaY6C2
+ BldKKmNIKkNDyr/CePvtt7l16xaHh4fcutWEq8PhkMFgwObGJod3Dx+rz/BiyP7+PlEUMRwO
+ ARgMBgwGA95++20ODg548803GQwGHB4dEicxSZxgsQyHQ15++fOAJY5jXn75ZY6OjnjnnXd4
+ 442fejzfm2/+POeTKQcHH7K5OeDw8PDx+wwGA4bDIVEU8cYbb/DOO+9wcXHB/v7+cqec/atx
+ fWNjgyiKOD8/5/z8nHfeeYeDgwP+4A//gA8++IDz4TlP7j9JGIYcHh5ycHDwePGPxuuvv85v
+ /MZvLMVH8sGHP2E4HGKxRFHEYLDJ0dEhcRyTJMlSUmK+9a1vcXR0SBSFDIfnjwlxcPABh4eH
+ j58TRRFHR0ePn/donm9+85scHR0hfue/+QeWz4b0f+6X+f9uCB7vrf1XqPuIK/+6EccJrVb0
+ /+gJR0dH7O/v/5Xf8NH9jRew9jFlhsMhrVaLKIpIkoQoioiiiIuLC4DHxx/9/sscHQ6Hj+9/
+ RIjBYJM4mZPEMRsbGwC8886fcevW/uP5H92fJDEXF8PHnGo42Obi4hyA/f19jo6OHp87ODhY
+ EkHQarUeS0GSxI+vaf4nbGxskCTJv/TuBwcHqF/7xl9/i+uEn4xmjMdjXNdlNBrx7rvv4jgO
+ Dx8+xPM84jimKIpGTw8bkXx4csrBwQe8/PLLHBwccHR0xObmJufn58RxwtHRIUdHh7hOU5vf
+ 29vj6OgI1/M5OrpHURR85zvf5bnnnmM8HvP222/z3HPPcXx8zHg8Zji84NNPP37sjQaDAcfH
+ x7RaLT755BOSJFleN2Rvb4/f/u1/xPPPP0dZlhwfH3NwcPD42kd2oCgKer3eY2apX/vGz7zF
+ dcr2a19+fMHm5iZ7e3sAbG5uPub6I86WZUm/32dvd5dWq/XY0CRJwmg0otVq0e/3iaKIvb09
+ XNelKAqiKKIsS4oiZ3OwQasVcetWYxz7/f5jbrmuS6vVYnNz8JiLrVbTdXrEpH6/j+u6PPfc
+ cwgh6PV69Pt9xuMxRVHQarW4desWrusSRRGtVgshxONzQghc10X8zn/9n8LtK9v/+W/w/8Mh
+ /i957VpDfrfOMwAAAABJRU5ErkJggg=='
+ 	readStream) readStream) nextImage
+ !

Item was added:
+ ----- Method: WebCamMorph class>>initialize (in category 'class initialization') -----
+ initialize
+ 	"CameraMorph initialize"
+ 
+ 
+ 	
+ !

Item was added:
+ ----- Method: WebCamMorph class>>resolutionFor: (in category 'scripting') -----
+ resolutionFor: aSymbol
+ 	(#(#low #medium #high) includes: aSymbol) ifFalse: [^ 320 at 240].
+ 
+ 	^ {160 at 120. 320 at 240. 640 at 480} 
+ 			at: (WebCamResolution resolutions indexOf: aSymbol)
+ !

Item was added:
+ ----- Method: WebCamMorph class>>shutDown (in category 'accessing') -----
+ shutDown
+ 	self allOff.
+ !

Item was added:
+ ----- Method: WebCamMorph class>>startUp (in category 'accessing') -----
+ startUp
+ 	"Try to bring up any instances that were on before shutdown"
+ !

Item was added:
+ ----- Method: WebCamMorph>>addCustomMenuItems:hand: (in category 'menu') -----
+ addCustomMenuItems: aMenu hand: aHandMorph 
+ 	| item |
+ 	super addCustomMenuItems: aMenu hand: aHandMorph.
+ 	item := (camIsOn == true)
+ 				ifTrue:	['turn camera off' translated]
+ 				ifFalse: ['turn camera on' translated].
+ 	aMenu
+ 		add: item translated
+ 		target: self
+ 		action: #toggleCameraOnOff.
+ 	
+ 	
+ 
+ 	
+ 	!

Item was added:
+ ----- Method: WebCamMorph>>delete (in category 'submorphs-add/remove') -----
+ delete
+ 	(self class instanceCount > 1) 
+ 	ifFalse:[self off]
+ 	ifTrue:[self stopStepping. camIsOn := false].
+ 	super delete.!

Item was added:
+ ----- Method: WebCamMorph>>drawOn: (in category 'drawing') -----
+ drawOn: aCanvas 
+ 	useFrameSize ifTrue: [self extent: frameExtent].
+ 	aCanvas
+ 		drawImage: (
+ 			(self extent = displayForm extent) 
+ 				ifTrue: [displayForm] 
+ 				ifFalse: [displayForm scaledToSize: self extent]
+ 		) at: bounds origin.
+ !

Item was added:
+ ----- Method: WebCamMorph>>getLastFrame (in category 'e-toy - settings') -----
+ getLastFrame
+ 
+ 	
+ 	^ SketchMorph withForm: displayForm deepCopy!

Item was added:
+ ----- Method: WebCamMorph>>getUseFrameSize (in category 'e-toy - settings') -----
+ getUseFrameSize
+ 	^ useFrameSize
+ !

Item was added:
+ ----- Method: WebCamMorph>>getWebCamIsOn (in category 'e-toy - settings') -----
+ getWebCamIsOn
+ 
+ 	^ camIsOn!

Item was added:
+ ----- Method: WebCamMorph>>getWebCamResolution (in category 'e-toy - settings') -----
+ getWebCamResolution
+ 	^ resolution
+ 			
+ !

Item was added:
+ ----- Method: WebCamMorph>>initialize (in category 'initialization') -----
+ initialize
+ 	super initialize.
+ 	camNum := 1.
+ 	camIsOn := false.
+ 	captureDelayMs := 0. "stepTime"	
+ 	useFrameSize := false.
+ 	resolution := #'medium'.
+ 	frameExtent := self class resolutionFor: resolution.
+ 	displayForm := Form extent: frameExtent depth:32.
+ 	self extent: frameExtent.
+ 	self on.
+ 
+ 	!

Item was added:
+ ----- Method: WebCamMorph>>intoWorld: (in category 'initialization') -----
+ intoWorld: aWorld
+ 
+ 	super intoWorld: aWorld.
+ 	camIsOn ifTrue: [self on]
+ 					ifFalse:[self off].
+ 	self removeActionsForEvent: #aboutToEnterWorld.
+ 	aWorld
+ 		when: #aboutToLeaveWorld
+ 		send: #outOfWorld:
+ 		to: self
+ 		with: aWorld.!

Item was added:
+ ----- Method: WebCamMorph>>nextFrame (in category 'stepping and presenter') -----
+ nextFrame
+ 	
+ 	CameraInterface getFrameForCamera: camNum into: displayForm bits.
+ 	!

Item was added:
+ ----- Method: WebCamMorph>>off (in category 'accessing') -----
+ off
+ 	self stopStepping.
+ 	camIsOn := false.
+ 	self updateDisplay.
+ 	CameraInterface  closeCamera: camNum.
+ 	
+ 
+ 	
+ !

Item was added:
+ ----- Method: WebCamMorph>>on (in category 'accessing') -----
+ on
+ 	
+ 	(CameraInterface cameraIsOpen: camNum)
+ 		ifTrue: [ ^camIsOn := true.].
+ 	(CameraInterface
+ 		openCamera: camNum
+ 		width: frameExtent x
+ 		height: frameExtent y)
+ 		ifNil: [^false].
+ 	(Delay forSeconds: 2) wait.
+ 	displayForm := Form extent: frameExtent depth:32.
+ 	camIsOn := true.
+ 	self startStepping.
+ 	!

Item was added:
+ ----- Method: WebCamMorph>>outOfWorld: (in category 'initialization') -----
+ outOfWorld: aWorld
+ 
+ 	super outOfWorld: aWorld.
+ 	camIsOn ifTrue: [self off. camIsOn := true].
+ 	aWorld
+ 		when: #aboutToEnterWorld
+ 		send: #intoWorld:
+ 		to: self
+ 		with: aWorld.!

Item was added:
+ ----- Method: WebCamMorph>>setUseFrameSize: (in category 'e-toy - settings') -----
+ setUseFrameSize: aBoolean
+ 	useFrameSize := aBoolean!

Item was added:
+ ----- Method: WebCamMorph>>setWebCamIsOn: (in category 'e-toy - settings') -----
+ setWebCamIsOn: aBoolean
+ 	aBoolean ifTrue: [self on] ifFalse: [self off]
+ !

Item was added:
+ ----- Method: WebCamMorph>>setWebCamResolution: (in category 'e-toy - settings') -----
+ setWebCamResolution: aSymbol
+ 	| wasOn |
+ 
+ 	((WebCamResolution resolutions) includes: aSymbol) ifFalse: [^ self].
+ 	resolution := aSymbol.
+ 
+ 	(wasOn := camIsOn) ifTrue: [self off].
+ 	frameExtent := self class resolutionFor: aSymbol.
+ 	displayForm := displayForm scaledToSize: frameExtent.
+ 	self updateDisplay.
+      wasOn ifTrue: [self on].
+ 			
+ 
+ !

Item was added:
+ ----- Method: WebCamMorph>>step (in category 'stepping and presenter') -----
+ step
+ 	camIsOn ifFalse:[self stopStepping].
+ 	self updateDisplay.
+ 	
+ 									!

Item was added:
+ ----- Method: WebCamMorph>>stepTime (in category 'stepping and presenter') -----
+ stepTime
+ 	"Answer the desired time between steps in milliseconds"
+ 	^ captureDelayMs
+ !

Item was added:
+ ----- Method: WebCamMorph>>toggleCameraOnOff (in category 'menu') -----
+ toggleCameraOnOff
+ 	camIsOn
+ 			ifTrue:[self off]
+ 			ifFalse:[self on]!

Item was added:
+ ----- Method: WebCamMorph>>updateDisplay (in category 'stepping and presenter') -----
+ updateDisplay
+ 	camIsOn
+ 		ifFalse: [displayForm getCanvas
+ 				drawString: 'Camera is off' translated
+ 				at: 5 @ 2
+ 				font: Preferences windowTitleFont
+ 				color: Color white.
+ 			]
+ 		ifTrue:[self nextFrame].
+      self changed.!

Item was added:
+ SymbolListType subclass: #WebCamResolution
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-MorphicExtras-WebCam'!

Item was added:
+ ----- Method: WebCamResolution class>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 	Vocabulary initialize!

Item was added:
+ ----- Method: WebCamResolution class>>resolutions (in category 'as yet unclassified') -----
+ resolutions
+ 	^ #(#'low' #'medium' #'high')
+ !

Item was added:
+ ----- Method: WebCamResolution>>initialize (in category 'as yet unclassified') -----
+ initialize
+ 	super initialize.
+ 	self vocabularyName: #WebCamResolution.
+ 	
+ 	self symbols: self class resolutions
+ !

Item was added:
+ ----- Method: WebCamResolution>>representsAType (in category 'as yet unclassified') -----
+ representsAType
+ 	^true!

Item was added:
+ AlignmentMorph subclass: #WeekMorph
+ 	instanceVariableNames: 'week month tileRect'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-PDA'!
+ 
+ !WeekMorph commentStamp: '<historical>' prior: 0!
+ Shows the current week as a row of buttons with numbers on. See MonthMorph!

Item was added:
+ ----- Method: WeekMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 	"Return true for all classes that can be instantiated from the menu"
+ 	^ false!

Item was added:
+ ----- Method: WeekMorph class>>newWeek:month:tileRect:model: (in category 'instance creation') -----
+ newWeek: aWeek month: aMonth tileRect: rect model: aModel
+ 
+ 	^ self basicNew initializeForWeek: aWeek month: aMonth tileRect: rect model: aModel
+ !

Item was added:
+ ----- Method: WeekMorph class>>on: (in category 'instance creation') -----
+ on: aDate
+ 	^ self new
+ 		week: aDate asWeek
+ 		month: aDate asMonth
+ 		model: nil!

Item was added:
+ ----- Method: WeekMorph>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	^ self initializeForWeek: Date today asWeek
+ 		month: Date today asMonth
+ 		tileRect: (0 at 0 extent: 23 at 19)
+ 		model: nil!

Item was added:
+ ----- Method: WeekMorph>>initializeDays: (in category 'all') -----
+ initializeDays: modelOrNil
+ 	| extent days tile |
+ 	self removeAllMorphs.
+ 	days _ OrderedCollection new: 7.
+ 	extent _ self tile extent.
+ 	week datesDo:
+ 		[:each |
+ 		tile _ (self tileLabeled: each dayOfMonth printString) extent: extent.
+ 		each month = month ifFalse:
+ 			[tile color: Color gray; offColor: Color gray; onColor: Color veryLightGray].
+ 		modelOrNil ifNotNil:
+ 			[tile target: modelOrNil;
+ 				actionSelector: #setDate:fromButton:down:;
+ 				arguments: {each. tile}].
+ 		days add: tile].
+ 	days reverseDo: [:each | self addMorph: each]!

Item was added:
+ ----- Method: WeekMorph>>initializeForWeek:month:tileRect:model: (in category 'all') -----
+ initializeForWeek: aWeek month: aMonth tileRect: rect model: aModel
+ 
+ 	super initialize.
+ 	tileRect _ rect.
+ 	self 
+ 		layoutInset: 0;
+ 		color: Color transparent;
+ 		listDirection: #leftToRight;
+ 		hResizing: #shrinkWrap;
+ 		disableDragNDrop;
+ 		height: tileRect height.
+ 
+ 	self week: aWeek month: aMonth model: aModel
+ !

Item was added:
+ ----- Method: WeekMorph>>next (in category 'all') -----
+ next
+ 	^ self class on: week next!

Item was added:
+ ----- Method: WeekMorph>>selectedDates (in category 'all') -----
+ selectedDates
+ 	| answer |
+ 	answer _ SortedCollection new.
+ 	self submorphsDo:
+ 		[:each |
+ 		((each respondsTo: #onColor) and: [each color = each onColor])
+ 			ifTrue:
+ 				[answer add:
+ 					(Date
+ 						newDay: each label asNumber
+ 						month: week firstDate monthName
+ 						year: week firstDate year)]].
+ 	^ answer!

Item was added:
+ ----- Method: WeekMorph>>tile (in category 'all') -----
+ tile
+ 	| onColor offColor |
+ 	offColor _ Color r: 0.4 g: 0.8 b: 0.6.
+ 	onColor _ offColor alphaMixed: 1/2 with: Color white.
+ 	^ SimpleSwitchMorph new
+ 		offColor: offColor;
+ 		onColor: onColor;
+ 		borderWidth: 1;
+ 		useSquareCorners;
+ 		extent: tileRect extent!

Item was added:
+ ----- Method: WeekMorph>>tileLabeled: (in category 'all') -----
+ tileLabeled: labelString
+ 	| onColor offColor |
+ 	offColor _ Color r: 0.4 g: 0.8 b: 0.6.
+ 	onColor _ offColor alphaMixed: 1/2 with: Color white.
+ 	^ (SimpleSwitchMorph newWithLabel: labelString)
+ 		offColor: offColor;
+ 		onColor: onColor;
+ 		borderWidth: 1;
+ 		useSquareCorners;
+ 		extent: tileRect extent;
+ 		setSwitchState: false!

Item was added:
+ ----- Method: WeekMorph>>title (in category 'all') -----
+ title
+ 	"Answer a title with the names of the days."
+ 	| title extent days |
+ 	title _ AlignmentMorph new
+ 		layoutInset: 0;
+ 		color: Color red;
+ 		listDirection: #leftToRight;
+ 		vResizing: #shrinkWarp;
+ 		height: tileRect height.
+ 		extent _ self tile extent.
+ 		
+ 	days _ (Week startDay = #Monday)
+ 		ifTrue: [ #(2 3 4 5 6 7 1) ]
+ 		ifFalse: [ 1 to: 7 ].
+ 		
+ 	(days reverse collect: [:each | Date nameOfDay: each]) do:
+ 		[:each |
+ 		title addMorph:
+ 			((self tileLabeled: (each copyFrom: 1 to: 2))
+ 				extent: extent)].
+ 	^ title
+ 	!

Item was added:
+ ----- Method: WeekMorph>>week:month:model: (in category 'all') -----
+ week: aWeek month: aMonth model: aModel
+ 	week _ aWeek.
+ 	month _ aMonth.
+ 	self initializeDays: aModel!

Item was added:
+ PasteUpMorph subclass: #WiWPasteUpMorph
+ 	instanceVariableNames: 'parentWorld hostWindow pendingEvent displayChangeSignatureOnEntry'
+ 	classVariableNames: 'Debug'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Worlds'!
+ 
+ !WiWPasteUpMorph commentStamp: '<historical>' prior: 0!
+ This subclass of PasteUpMorph provides special support for viewing of a world in an inner window (WorldWindow).!

Item was added:
+ ----- Method: WiWPasteUpMorph class>>say: (in category 'as yet unclassified') -----
+ say: x
+ 
+ 	(Debug ifNil: [Debug _ OrderedCollection new])
+ 		add: x asString,'
+ '.
+ 	Debug size > 500 ifTrue: [Debug _ Debug copyFrom: 200 to: Debug size]!

Item was added:
+ ----- Method: WiWPasteUpMorph class>>show (in category 'as yet unclassified') -----
+ show
+ 
+ 	Debug inspect.
+ 	Debug _ OrderedCollection new.!

Item was added:
+ ----- Method: WiWPasteUpMorph>>becomeTheActiveWorldWith: (in category 'activation') -----
+ becomeTheActiveWorldWith: evt
+ 	"Make the receiver become the active world, and give its hand the event provided, if not nil"
+ 
+ 	| outerWorld |
+ 	World == self ifTrue: [^ self].
+ 	worldState resetDamageRecorder.	"since we may have moved, old data no longer valid"
+ 	hostWindow setStripeColorsFrom: Color green.
+ 	worldState canvas: nil.	"safer to start from scratch"
+ 	displayChangeSignatureOnEntry _ Display displayChangeSignature.
+ 
+ 	"Messy stuff to clear flaps from outer world"
+ 	Flaps globalFlapTabsIfAny do: [:f | f changed].
+ 	outerWorld _ World.
+ 	World _ self.
+ 	self installFlaps.
+ 	World _ outerWorld.
+ 	outerWorld displayWorld.
+ 	World _ self.
+ 
+ 	self viewBox: hostWindow panelRect.
+ 	self startSteppingSubmorphsOf: self.
+ 	self changed.
+ 	pendingEvent _ nil.
+ 	evt ifNotNil: [self primaryHand handleEvent: (evt setHand: self primaryHand)].
+ 
+ !

Item was added:
+ ----- Method: WiWPasteUpMorph>>displayWorld (in category 'world state') -----
+ displayWorld
+ 
+ 	"RAA 27 Nov 99 - if we are not active, then the parent should do the drawing"
+ 
+ 	self flag: #bob.			"probably not needed"
+ 
+ 	World == self ifTrue: [^super displayWorld].
+ 	parentWorld ifNotNil: [^parentWorld displayWorld].
+ 	^super displayWorld		"in case MVC needs it"!

Item was added:
+ ----- Method: WiWPasteUpMorph>>doDeferredUpdating (in category 'update cycle') -----
+ doDeferredUpdating
+ 	"If this platform supports deferred updates, then make my canvas be the Display (or a rectangular portion of it), set the Display to deferred update mode, and answer true. Otherwise, do nothing and answer false. One can set the class variable DisableDeferredUpdates to true to completely disable the deferred updating feature."
+ 
+ 	PasteUpMorph disableDeferredUpdates ifTrue: [^ false].
+ 	(Display deferUpdates: true) ifNil: [^ false].  "deferred updates not supported"
+ 
+ 	self resetViewBox.
+ 	^ true
+ !

Item was added:
+ ----- Method: WiWPasteUpMorph>>doOneCycle (in category 'world state') -----
+ doOneCycle
+ 
+ 	pendingEvent ifNotNil: [
+ 		self primaryHand handleEvent: (pendingEvent setHand: self primaryHand).
+ 		pendingEvent _ nil.
+ 	].
+ 	^super doOneCycle.!

Item was added:
+ ----- Method: WiWPasteUpMorph>>extent: (in category 'geometry') -----
+ extent: x
+ 
+ 	super extent: x.
+ 	self resetViewBox.!

Item was added:
+ ----- Method: WiWPasteUpMorph>>goBack (in category 'world state') -----
+ goBack
+ 	"Return to the previous project.  For the moment, this is not allowed from inner worlds"
+ 
+ 	self inform: 'Project changes are not yet allowed
+ from inner worlds.'!

Item was added:
+ ----- Method: WiWPasteUpMorph>>hostWindow: (in category 'initialization') -----
+ hostWindow: x
+ 
+ 	hostWindow _ x.
+ 	worldState canvas: nil.	"safer to start from scratch"
+ 	self viewBox: hostWindow panelRect.
+ !

Item was added:
+ ----- Method: WiWPasteUpMorph>>initialize (in category 'initialization') -----
+ initialize
+ 
+ 	super initialize.
+ 	parentWorld _ World.
+ !

Item was added:
+ ----- Method: WiWPasteUpMorph>>jumpToProject (in category 'world state') -----
+ jumpToProject
+ 	"Jump directly to another project.  However, this is not currently allowed for inner worlds"
+ 
+ 	self inform: 'Project changes are not yet allowed
+ from inner worlds.'!

Item was added:
+ ----- Method: WiWPasteUpMorph>>mouseDown: (in category 'event handling') -----
+ mouseDown: evt
+ 
+ 	(World == self or: [World isNil]) ifTrue: [^ super mouseDown: evt].
+ 	(self bounds containsPoint: evt cursorPoint) ifFalse: [^ self].
+ 
+ 	self becomeTheActiveWorldWith: evt.
+ !

Item was added:
+ ----- Method: WiWPasteUpMorph>>resetViewBox (in category 'geometry') -----
+ resetViewBox
+ 	| c |
+ 	(c := worldState canvas) isNil ifTrue: [^self resetViewBoxForReal].
+ 	c form == Display ifFalse: [^self resetViewBoxForReal].
+ 	c origin = (0 @ 0) ifFalse: [^self resetViewBoxForReal].
+ 	c clipRect extent = (self viewBox intersect: parentWorld viewBox) extent 
+ 		ifFalse: [^self resetViewBoxForReal]!

Item was added:
+ ----- Method: WiWPasteUpMorph>>resetViewBoxForReal (in category 'geometry') -----
+ resetViewBoxForReal
+ 
+ 	| newClip |
+ 	self viewBox ifNil: [^self].
+ 	newClip _ self viewBox intersect: parentWorld viewBox.
+ 	worldState canvas: (
+ 		Display getCanvas
+ 			copyOffset:  0 at 0
+ 			clipRect: newClip
+ 	)!

Item was added:
+ ----- Method: WiWPasteUpMorph>>restartWorldCycleWithEvent: (in category 'WiW support') -----
+ restartWorldCycleWithEvent: evt
+ 
+ 	"redispatch that click in outer world"
+ 
+ 	pendingEvent _ evt.
+ 	CurrentProjectRefactoring currentSpawnNewProcessAndTerminateOld: true
+ !

Item was added:
+ ----- Method: WiWPasteUpMorph>>restoreDisplay (in category 'world state') -----
+ restoreDisplay
+ 
+ 	World ifNotNil:[World restoreMorphicDisplay].	"I don't actually expect this to be called"!

Item was added:
+ ----- Method: WiWPasteUpMorph>>revertToParentWorldWithEvent: (in category 'activation') -----
+ revertToParentWorldWithEvent: evt
+ 
+ 	"RAA 27 Nov 99 - if the display changed while we were in charge, parent may need to redraw"
+ 
+ 	worldState resetDamageRecorder.	"Terminate local display"
+ 	World _ parentWorld.
+ 	World assuredCanvas.
+ 	World installFlaps.
+ 	hostWindow setStripeColorsFrom: Color red.
+ 	(displayChangeSignatureOnEntry = Display displayChangeSignature) ifFalse: [
+ 		World fullRepaintNeeded; displayWorld
+ 	].
+ 	evt ifNotNil: [World restartWorldCycleWithEvent: evt].
+ 
+ !

Item was added:
+ ----- Method: WiWPasteUpMorph>>validateMouseEvent: (in category 'WiW support') -----
+ validateMouseEvent: evt
+ 
+ 	evt isMouseDown ifFalse: [^ self].
+ 
+ 	"any click outside returns us to our home world"
+ 	(self bounds containsPoint: evt cursorPoint) ifFalse: [
+ 		self revertToParentWorldWithEvent: evt.
+ 	].!

Item was added:
+ ----- Method: WiWPasteUpMorph>>viewBox: (in category 'project state') -----
+ viewBox: newViewBox 
+ 	| vb |
+ 	worldState resetDamageRecorder.	"since we may have moved, old data no longer valid"
+ 	((vb := self viewBox) isNil or: [vb ~= newViewBox]) 
+ 		ifTrue: [worldState canvas: nil].
+ 	worldState viewBox: newViewBox.
+ 	bounds := newViewBox.
+ 	worldState assuredCanvas.
+ 	"Paragraph problem workaround; clear selections to avoid screen droppings:"
+ 	self flag: #arNote.	"Probably unnecessary"
+ 	worldState handsDo: [:h | h releaseKeyboardFocus].
+ 	self fullRepaintNeeded!

Item was added:
+ PolygonMorph subclass: #WireMorph
+ 	instanceVariableNames: 'pins'
+ 	classVariableNames: 'InputPinForm IoPinForm OutputPinForm'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Components'!

Item was added:
+ ----- Method: WireMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 	^ false!

Item was added:
+ ----- Method: WireMorph>>addHandles (in category 'editing') -----
+ addHandles
+ 	super addHandles.
+ 	"Don't show endpoint handles"
+ 	handles first delete.
+ 	handles last delete!

Item was added:
+ ----- Method: WireMorph>>delete (in category 'submorphs-add/remove') -----
+ delete
+ 	pins do: [:p | p removeWire: self].
+ 	pins first isIsolated 
+ 		ifTrue: [pins first removeVariableAccess.
+ 				pins second isIsolated
+ 					ifTrue: [pins second removeModelVariable]]
+ 		ifFalse: [pins second isIsolated
+ 					ifTrue: [pins second removeVariableAccess]
+ 					ifFalse: [pins second addModelVariable]].
+ 	super delete!

Item was added:
+ ----- Method: WireMorph>>fromPin:toPin: (in category 'as yet unclassified') -----
+ fromPin: pin1 toPin: pin2
+ 	pins _ Array with: pin1 with: pin2!

Item was added:
+ ----- Method: WireMorph>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: evt
+ 	^ evt buttons noMask: 16r78  "ie no modifier keys pressed"!

Item was added:
+ ----- Method: WireMorph>>mouseUp: (in category 'event handling') -----
+ mouseUp: evt 
+ 	handles isNil ifTrue: [self addHandles] ifFalse: [self removeHandles]!

Item was added:
+ ----- Method: WireMorph>>otherPinFrom: (in category 'as yet unclassified') -----
+ otherPinFrom: aPin 
+ 	^ pins first = aPin ifTrue: [pins second] ifFalse: [pins first]!

Item was added:
+ ----- Method: WireMorph>>pinMoved (in category 'as yet unclassified') -----
+ pinMoved
+ 	| newVerts |
+ 	newVerts _ vertices copy.
+ 	newVerts at: 1 put: pins first wiringEndPoint.
+ 	newVerts at: newVerts size put: pins last wiringEndPoint.
+ 	self setVertices: newVerts!

Item was added:
+ ----- Method: WordArray>>eToysEQ: (in category '*Etoys-Squeakland-array arithmetic') -----
+ eToysEQ: other
+ 
+ 	| result |
+ 	result _ ByteArray new: self size.
+ 	other isNumber ifTrue: [
+ 		^ self primEQScalar: self and: other into: result.
+ 	].
+ 	other isCollection ifTrue: [
+ 		^ self primEQArray: self and: other into: result.
+ 	].
+ 	^ super = other.
+ !

Item was added:
+ ----- Method: WordArray>>eToysGE: (in category '*Etoys-Squeakland-array arithmetic') -----
+ eToysGE: other
+ 
+ 	| result |
+ 	result _ ByteArray new: self size.
+ 	other isNumber ifTrue: [
+ 		^ self primGEScalar: self and: other into: result.
+ 	].
+ 	other isCollection ifTrue: [
+ 		^ self primGEArray: self and: other into: result.
+ 	].
+ 	^ super >= other.
+ !

Item was added:
+ ----- Method: WordArray>>eToysGT: (in category '*Etoys-Squeakland-array arithmetic') -----
+ eToysGT: other
+ 
+ 	| result |
+ 	result _ ByteArray new: self size.
+ 	other isNumber ifTrue: [
+ 		^ self primGTScalar: self and: other into: result.
+ 	].
+ 	other isCollection ifTrue: [
+ 		^ self primGTArray: self and: other into: result.
+ 	].
+ 	^ super > other.
+ !

Item was added:
+ ----- Method: WordArray>>eToysLE: (in category '*Etoys-Squeakland-array arithmetic') -----
+ eToysLE: other
+ 
+ 	| result |
+ 	result _ ByteArray new: self size.
+ 	other isNumber ifTrue: [
+ 		^ self primLEScalar: self and: other into: result.
+ 	].
+ 	other isCollection ifTrue: [
+ 		^ self primLEArray: self and: other into: result.
+ 	].
+ 	^ super <= other.
+ !

Item was added:
+ ----- Method: WordArray>>eToysLT: (in category '*Etoys-Squeakland-array arithmetic') -----
+ eToysLT: other
+ 
+ 	| result |
+ 	result _ ByteArray new: self size.
+ 	other isNumber ifTrue: [
+ 		^ self primLTScalar: self and: other into: result.
+ 	].
+ 	other isCollection ifTrue: [
+ 		^ self primLTArray: self and: other into: result.
+ 	].
+ 	^ super < other.
+ !

Item was added:
+ ----- Method: WordArray>>eToysNE: (in category '*Etoys-Squeakland-array arithmetic') -----
+ eToysNE: other
+ 
+ 	| result |
+ 	result _ ByteArray new: self size.
+ 	other isNumber ifTrue: [
+ 		^ self primNEScalar: self and: other into: result.
+ 	].
+ 	other isCollection ifTrue: [
+ 		^ self primNEArray: self and: other into: result.
+ 	].
+ 	^ super ~= other.
+ !

Item was changed:
  ----- Method: WordArray>>primAddArray:and:into: (in category '*Etoys-arithmetic') -----
  primAddArray: rcvr and: other into: result
  
+ 	<primitive: 'primitiveAddArrays' module:'KedamaPlugin2'>
- 	<primitive: 'primitiveAddArrays' module:'KedamaPlugin'>
  	"^ KedamaPlugin doPrimitive: #primitiveAddArrays."
  
  	1 to: rcvr size do: [:i |
  		result at: i put: (rcvr at: i) + (other at: i)
  	].
  	^ result.
  !

Item was changed:
  ----- Method: WordArray>>primAddScalar:and:into: (in category '*Etoys-arithmetic') -----
  primAddScalar: rcvr and: other into: result
  
+ 	<primitive: 'primitiveAddScalar' module:'KedamaPlugin2'>
- 	<primitive: 'primitiveAddScalar' module:'KedamaPlugin'>
  	"^ KedamaPlugin doPrimitive: #primitiveAddScalar."
  
  	1 to: rcvr size do: [:i |
  		result at: i put: (rcvr at: i) + other.
  	].
  	^ result.
  !

Item was changed:
  ----- Method: WordArray>>primDivArray:and:into: (in category '*Etoys-arithmetic') -----
  primDivArray: rcvr and: other into: result
  
+ 	<primitive: 'primitiveDivArrays' module:'KedamaPlugin2'>
- 	<primitive: 'primitiveDivArrays' module:'KedamaPlugin'>
  	"^ KedamaPlugin doPrimitive: #primitiveDivArrays."
  
  	1 to: rcvr size do: [:i |
  		result at: i put: (rcvr at: i) / (other at: i)
  	].
  	^ result.
  !

Item was changed:
  ----- Method: WordArray>>primDivScalar:and:into: (in category '*Etoys-arithmetic') -----
  primDivScalar: rcvr and: other into: result
  
+ 	<primitive: 'primitiveDivScalar' module:'KedamaPlugin2'>
- 	<primitive: 'primitiveDivScalar' module:'KedamaPlugin'>
  	"^ KedamaPlugin doPrimitive: #primitiveDivScalar."
  
  	1 to: rcvr size do: [:i |
  		result at: i put: (rcvr at: i) / other.
  	].
  	^ result.
  !

Item was added:
+ ----- Method: WordArray>>primEQArray:and:into: (in category '*Etoys-Squeakland-array arithmetic primitives') -----
+ primEQArray: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveEQArrays' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #primitiveEQArrays."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) = (other at: i) ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: WordArray>>primEQScalar:and:into: (in category '*Etoys-Squeakland-array arithmetic primitives') -----
+ primEQScalar: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveEQScalar' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #primitiveEQScalar."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) = other ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: WordArray>>primGEArray:and:into: (in category '*Etoys-Squeakland-array arithmetic primitives') -----
+ primGEArray: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveGEArrays' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #primitiveGEArrays."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) >= (other at: i) ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: WordArray>>primGEScalar:and:into: (in category '*Etoys-Squeakland-array arithmetic primitives') -----
+ primGEScalar: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveGEScalar' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #primitiveGEScalar."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) >= other ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: WordArray>>primGTArray:and:into: (in category '*Etoys-Squeakland-array arithmetic primitives') -----
+ primGTArray: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveGTArrays' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #primitiveGTArrays."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) > (other at: i) ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: WordArray>>primGTScalar:and:into: (in category '*Etoys-Squeakland-array arithmetic primitives') -----
+ primGTScalar: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveGTScalar' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #primitiveGTScalar."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) > other ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: WordArray>>primLEArray:and:into: (in category '*Etoys-Squeakland-array arithmetic primitives') -----
+ primLEArray: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveLEArrays' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #primitiveLEArrays."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) <= (other at: i) ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: WordArray>>primLEScalar:and:into: (in category '*Etoys-Squeakland-array arithmetic primitives') -----
+ primLEScalar: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveLEScalar' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #primitiveLEScalar."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) <= other ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: WordArray>>primLTArray:and:into: (in category '*Etoys-Squeakland-array arithmetic primitives') -----
+ primLTArray: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveLTArrays' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #primitiveLTArrays."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) < (other at: i) ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: WordArray>>primLTScalar:and:into: (in category '*Etoys-Squeakland-array arithmetic primitives') -----
+ primLTScalar: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveLTScalar' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #primitiveLTScalar."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) < other ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was changed:
  ----- Method: WordArray>>primMulArray:and:into: (in category '*Etoys-arithmetic') -----
  primMulArray: rcvr and: other into: result
  
+ 	<primitive: 'primitiveMulArrays' module:'KedamaPlugin2'>
- 	<primitive: 'primitiveMulArrays' module:'KedamaPlugin'>
  	"^ KedamaPlugin doPrimitive: #primitiveMulArrays."
  
  	1 to: rcvr size do: [:i |
  		result at: i put: (rcvr at: i) * (other at: i)
  	].
  	^ result.
  !

Item was changed:
  ----- Method: WordArray>>primMulScalar:and:into: (in category '*Etoys-arithmetic') -----
  primMulScalar: rcvr and: other into: result
  
+ 	<primitive: 'primitiveMulScalar' module:'KedamaPlugin2'>
- 	<primitive: 'primitiveMulScalar' module:'KedamaPlugin'>
  	"^ KedamaPlugin doPrimitive: #primitiveMulScalar."
  
  	1 to: rcvr size do: [:i |
  		result at: i put: (rcvr at: i) * other.
  	].
  	^ result.
  !

Item was added:
+ ----- Method: WordArray>>primNEArray:and:into: (in category '*Etoys-Squeakland-array arithmetic primitives') -----
+ primNEArray: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveNEArrays' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #primitiveNEArrays."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) ~= (other at: i) ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was added:
+ ----- Method: WordArray>>primNEScalar:and:into: (in category '*Etoys-Squeakland-array arithmetic primitives') -----
+ primNEScalar: rcvr and: other into: result
+ 
+ 	<primitive: 'primitiveNEScalar' module:'KedamaPlugin2'>
+ 	"^ KedamaPlugin doPrimitive: #primitiveNEScalar."
+ 
+ 	1 to: rcvr size do: [:i |
+ 		result at: i put: ((rcvr at: i) ~= other ifTrue: [1] ifFalse: [0]).
+ 	].
+ 	^ result.
+ !

Item was changed:
  ----- Method: WordArray>>primSubArray:and:into: (in category '*Etoys-arithmetic') -----
  primSubArray: rcvr and: other into: result
  
+ 	<primitive: 'primitiveSubArrays' module:'KedamaPlugin2'>
- 	<primitive: 'primitiveSubArrays' module:'KedamaPlugin'>
  	"^ KedamaPlugin doPrimitive: #primitiveSubArrays."
  
  	1 to: rcvr size do: [:i |
  		result at: i put: (rcvr at: i) - (other at: i)
  	].
  	^ result.
  !

Item was changed:
  ----- Method: WordArray>>primSubScalar:and:into: (in category '*Etoys-arithmetic') -----
  primSubScalar: rcvr and: other into: result
  
+ 	<primitive: 'primitiveSubScalar' module:'KedamaPlugin2'>
- 	<primitive: 'primitiveSubScalar' module:'KedamaPlugin'>
  	"^ KedamaPlugin doPrimitive: #primitiveSubScalar."
  
  	1 to: rcvr size do: [:i |
  		result at: i put: (rcvr at: i) - other.
  	].
  	^ result.
  !

Item was added:
+ BorderedMorph subclass: #WordGameLetterMorph
+ 	instanceVariableNames: 'letter originalLetter idString linkedLetters predecessor successor indexInQuote lineMorph letterMorph style'
+ 	classVariableNames: 'IDFont IDHeight LetterFont LetterHeight'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!
+ 
+ !WordGameLetterMorph commentStamp: '<historical>' prior: 0!
+ WordGameLetterMorph implements letter boxes for type-in and display of letter in word games.  Several variant displays are supported, depending on the setting of style, and blanks can be displayed as black boxes or empty letter boxes.
+ 
+ Default support for type-in is distributed between this class and WordGamePaneMorph
+ 
+ letter			the Character stored in this morph.
+ 				Can be either blank or nil as well as a letter.
+ indexInQuote	a retained copy of the index of this character
+ 				Facilitates responses to, eg, clicking or typing in this box.
+ 				If indexInQuote==nil, then this is displayed as a black box
+ predecessor		another LetterMorph or nil
+ 				Used for linked typing and, eg, word selection
+ successor		another LetterMorph or nil
+ 				Used for linked typing and, eg, word selection
+ style			a Symbol, one of #(plain boxed underlined)
+ 				Boxed and underlined display further depends on whether
+ 				the id strings are nil or not.
+ 				Each format has an associated default size
+ 
+ The following two variables are also submorphs, as are the id strings if present.
+ letterMorph		a StringMorph for displaying the letter
+ 				Used when changing the letter to be displayed
+ lineMorph		a PolygonMorph used to display the underline
+ 				and also to place the id string in underlined format!

Item was added:
+ ----- Method: WordGameLetterMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 
+ 	^ false!

Item was added:
+ ----- Method: WordGameLetterMorph class>>initialize (in category 'class initialization') -----
+ initialize  "WordGameLetterMorph initialize"
+ 
+ 	IDFont _ StrikeFont familyName: 'ComicPlain' size: 13.
+ 	IDHeight _ IDFont height.
+ 	LetterFont _ StrikeFont familyName: 'ComicBold' size: 19.
+ 	LetterHeight _ LetterFont height.
+ 
+ !

Item was added:
+ ----- Method: WordGameLetterMorph>>boxed (in category 'style inits') -----
+ boxed
+ 
+ 	style _ #boxed!

Item was added:
+ ----- Method: WordGameLetterMorph>>handlesKeyboard: (in category 'event handling') -----
+ handlesKeyboard: evt
+ 	^ true!

Item was added:
+ ----- Method: WordGameLetterMorph>>id2: (in category 'initialization') -----
+ id2: idString
+ 	"Add further clue id for acrostic puzzles."
+ 
+ 	| idMorph |
+ 	idString ifNotNil:
+ 		[idMorph _ StringMorph contents: idString font: IDFont.
+ 		idMorph align: idMorph bounds topRight with: self bounds topRight + (-1 at -1).
+ 		self addMorph: idMorph].
+ 
+ !

Item was added:
+ ----- Method: WordGameLetterMorph>>indexInQuote (in category 'accessing') -----
+ indexInQuote
+ 
+ 	^ indexInQuote!

Item was added:
+ ----- Method: WordGameLetterMorph>>indexInQuote:id1: (in category 'initialization') -----
+ indexInQuote: qi id1: aString 
+ 	"Initialize me with the given index and an optional aString"
+ 	| idMorph y |
+ 	style = #boxed
+ 		ifTrue: [aString isNil
+ 				ifTrue: [self extent: 18 @ 16;
+ 						 borderWidth: 1]
+ 				ifFalse: [self extent: 26 @ 24;
+ 						 borderWidth: 1]]
+ 		ifFalse: [aString isNil
+ 				ifTrue: [self extent: 18 @ 16;
+ 						 borderWidth: 0]
+ 				ifFalse: [self extent: 18 @ 26;
+ 						 borderWidth: 0]].
+ 	qi
+ 		ifNil: [^ self color: Color gray].
+ 	"blank"
+ 	self color: self normalColor.
+ 	indexInQuote _ qi.
+ 	style == #underlined
+ 		ifTrue: [y _ self bottom - 2.
+ 			aString
+ 				ifNotNil: [y _ y - IDFont ascent + 2].
+ 			lineMorph _ PolygonMorph
+ 						vertices: {self left + 2 @ y. self right - 3 @ y}
+ 						color: Color gray
+ 						borderWidth: 1
+ 						borderColor: Color gray.
+ 			self addMorph: lineMorph.
+ 			aString
+ 				ifNil: [^ self].
+ 			idMorph _ StringMorph contents: aString font: IDFont.
+ 			idMorph align: idMorph bounds bottomCenter with: self bounds bottomCenter + (0 @ (IDFont descent - 1)).
+ 			self addMorphBack: idMorph]
+ 		ifFalse: [aString
+ 				ifNil: [^ self].
+ 			idMorph _ StringMorph contents: aString font: IDFont.
+ 			idMorph align: idMorph bounds topLeft with: self bounds topLeft + (2 @ -1).
+ 			self addMorph: idMorph
+ 			" 
+ 			World addMorph: (WordGameLetterMorph new boxed  
+ 			indexInQuote: 123 id1: '123';  
+ 			id2: 'H'; setLetter: $W).  
+ 			World addMorph: (WordGameLetterMorph new underlined  
+ 			indexInQuote: 123 id1: '123';  
+ 			setLetter: $W).  
+ 			World addMorph: (WordGameLetterMorph new underlined  
+ 			indexInQuote: 123 id1: nil;  
+ 			setLetter: $W). 
+ 			"]!

Item was added:
+ ----- Method: WordGameLetterMorph>>isBlank (in category 'accessing') -----
+ isBlank
+ 	^indexInQuote isNil!

Item was added:
+ ----- Method: WordGameLetterMorph>>keyboardFocusChange: (in category 'event handling') -----
+ keyboardFocusChange: boolean
+ 
+ 	| panel |
+ 	boolean ifFalse:
+ 		[panel _ self nearestOwnerThat: [:m | m respondsTo: #checkForLostFocus].
+ 		panel ifNotNil: [panel checkForLostFocus]]!

Item was added:
+ ----- Method: WordGameLetterMorph>>letter (in category 'accessing') -----
+ letter
+ 
+ 	^ letter!

Item was added:
+ ----- Method: WordGameLetterMorph>>morphsInWordDo: (in category 'linking') -----
+ morphsInWordDo: aBlock 
+ 	aBlock value: self.
+ 	(successor isNil or: [successor isBlank]) ifTrue: [^self].
+ 	successor morphsInWordDo: aBlock!

Item was added:
+ ----- Method: WordGameLetterMorph>>nextTypeableLetter (in category 'linking') -----
+ nextTypeableLetter
+ 
+ 	successor ifNil: [^ self].
+ 	successor isBlank ifTrue: [^ successor nextTypeableLetter].
+ 	^ successor!

Item was added:
+ ----- Method: WordGameLetterMorph>>normalColor (in category 'initialization') -----
+ normalColor
+ 
+ 	^ Color r: 1.0 g: 0.8 b: 0.2
+ !

Item was added:
+ ----- Method: WordGameLetterMorph>>plain (in category 'style inits') -----
+ plain
+ 
+ 	style _ #plain!

Item was added:
+ ----- Method: WordGameLetterMorph>>predecessor (in category 'accessing') -----
+ predecessor
+ 
+ 	^ predecessor!

Item was added:
+ ----- Method: WordGameLetterMorph>>predecessor: (in category 'accessing') -----
+ predecessor: pred
+ 
+ 	predecessor _ pred
+ !

Item was added:
+ ----- Method: WordGameLetterMorph>>previousTypeableLetter (in category 'linking') -----
+ previousTypeableLetter
+ 
+ 	predecessor ifNil: [^ self].
+ 	predecessor isBlank ifTrue: [^ predecessor previousTypeableLetter].
+ 	^ predecessor!

Item was added:
+ ----- Method: WordGameLetterMorph>>setLetter: (in category 'initialization') -----
+ setLetter: aLetter
+ 
+ 	^ self setLetter: aLetter color: Color black
+ !

Item was added:
+ ----- Method: WordGameLetterMorph>>setLetter:color: (in category 'initialization') -----
+ setLetter: aLetter color: aColor 
+ 	letterMorph ifNotNil: [letterMorph delete].
+ 	letter := aLetter.
+ 	letter ifNil: [^letterMorph := nil].
+ 	letterMorph := StringMorph contents: aLetter asString font: LetterFont.
+ 	letterMorph color: aColor.
+ 	style == #boxed 
+ 		ifTrue: 
+ 			[letterMorph align: letterMorph bounds bottomCenter
+ 				with: self bounds bottomCenter + (0 @ (LetterFont descent - 2))]
+ 		ifFalse: 
+ 			[lineMorph isNil 
+ 				ifTrue: 
+ 					[letterMorph align: letterMorph bounds bottomCenter
+ 						with: self bounds bottomCenter + (0 @ (LetterFont descent - 4))]
+ 				ifFalse: 
+ 					[letterMorph align: letterMorph bounds bottomCenter
+ 						with: self center x @ (lineMorph top + LetterFont descent)]].
+ 	self addMorphBack: letterMorph!

Item was added:
+ ----- Method: WordGameLetterMorph>>startOfWord (in category 'linking') -----
+ startOfWord
+ 	(predecessor isNil or: [predecessor isBlank]) ifTrue: [^self].
+ 	^predecessor startOfWord!

Item was added:
+ ----- Method: WordGameLetterMorph>>successor (in category 'accessing') -----
+ successor
+ 
+ 	^ successor!

Item was added:
+ ----- Method: WordGameLetterMorph>>successor: (in category 'accessing') -----
+ successor: succ
+ 
+ 	successor _ succ
+ !

Item was added:
+ ----- Method: WordGameLetterMorph>>underlined (in category 'style inits') -----
+ underlined
+ 
+ 	style _ #underlined!

Item was added:
+ ----- Method: WordGameLetterMorph>>unhighlight (in category 'typing') -----
+ unhighlight
+ 
+ 	(self isBlank or: [self color = self normalColor])
+ 		ifFalse: [self color: self normalColor]!

Item was added:
+ BorderedMorph subclass: #WordGamePanelMorph
+ 	instanceVariableNames: 'letterMorphs haveTypedHere'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Games'!
+ 
+ !WordGamePanelMorph commentStamp: '<historical>' prior: 0!
+ WordGamePanelMorph provides some default support for clicking and typing in a panel with letterMorphs.
+ 
+ letterMorphs		a collection of LetterMorphs
+ 					Useful in referring specifically to active letterMorphs
+ 					when submorphs may contain other morphs
+ 
+ haveTypedHere		a Boolean used to determine how backspace should be handled!

Item was added:
+ ----- Method: WordGamePanelMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 
+ 	^ false!

Item was added:
+ ----- Method: WordGamePanelMorph>>addCustomMenuItems:hand: (in category 'menus') -----
+ addCustomMenuItems: aCustomMenu hand: aHandMorph
+ 	"Include our modest command set in the ctrl-menu"
+ 
+ 	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ 	aCustomMenu addLine.
+ 	self addMenuItemsTo: aCustomMenu hand: aHandMorph!

Item was added:
+ ----- Method: WordGamePanelMorph>>addMenuItemsTo:hand: (in category 'menu') -----
+ addMenuItemsTo: aCustomMenu hand: aHandMorph
+ 	"override with actual menu items"!

Item was added:
+ ----- Method: WordGamePanelMorph>>checkForLostFocus (in category 'events') -----
+ checkForLostFocus
+ 	"Determine if the user has clicked outside this panel"
+ 
+ 	self activeHand ifNil: [^ self].
+ 	(self containsPoint: self activeHand position) ifFalse: [self lostFocus]!

Item was added:
+ ----- Method: WordGamePanelMorph>>clearTyping (in category 'defaults') -----
+ clearTyping
+ 	"Clear out all letters entered as a solution."
+ 
+ 	letterMorphs do: [:m | (m letter notNil and: [m letter isLetter])
+ 							ifTrue: [m setLetter: Character space]].
+ 	self unhighlight.
+ !

Item was added:
+ ----- Method: WordGamePanelMorph>>handlesMouseDown: (in category 'event handling') -----
+ handlesMouseDown: event
+ 	"Absorb mouseDown so stray clicks will not pick up the panel"
+ 
+ 	^ true!

Item was added:
+ ----- Method: WordGamePanelMorph>>highlight: (in category 'defaults') -----
+ highlight: morph
+ 
+ 	self unhighlight.
+ 	morph color: Color green!

Item was added:
+ ----- Method: WordGamePanelMorph>>isClean (in category 'defaults') -----
+ isClean
+ 	"Return true only if all cells are blank."
+ 
+ 	letterMorphs do:
+ 		[:m | (m letter notNil and: [m letter ~= $ ]) ifTrue: [^ false]].
+ 	^ true
+ !

Item was added:
+ ----- Method: WordGamePanelMorph>>keyCharacter:atIndex:nextFocus: (in category 'defaults') -----
+ keyCharacter: keyCharacter atIndex: indexOfAffectedMorph nextFocus: nextFocus
+ 
+ 	"Override with actual response"
+ !

Item was added:
+ ----- Method: WordGamePanelMorph>>keyStrokeEvent:letterMorph: (in category 'events') -----
+ keyStrokeEvent: evt letterMorph: morph 
+ 	"Handle typing.  Calls keyCharacter:atIndex:nextFocus: for further behavior."
+ 
+ 	| affectedMorph keyCharacter nextFocus |
+ 	evt keyCharacter = Character backspace 
+ 		ifTrue: 
+ 			["<delete> zaps the current selection if there has been no typing,
+ 				but it zaps the previous selection if there has been prior typing."
+ 
+ 			affectedMorph := haveTypedHere 
+ 						ifTrue: [morph previousTypeableLetter]
+ 						ifFalse: [morph]. 
+ 			keyCharacter := Character space.
+ 			nextFocus := morph previousTypeableLetter]
+ 		ifFalse: 
+ 			[affectedMorph := morph.
+ 			keyCharacter := evt keyCharacter asUppercase.
+ 			(keyCharacter isLetter or: [keyCharacter = Character space]) 
+ 				ifFalse: [^self].
+ 			haveTypedHere := true.
+ 			nextFocus := morph nextTypeableLetter.
+ 			nextFocus == morph 
+ 				ifTrue: 
+ 					["If hit end of a word, change backspace mode"
+ 
+ 					haveTypedHere := false]].
+ 	evt hand newKeyboardFocus: nextFocus.
+ 	self unhighlight.
+ 	nextFocus color: Color green.
+ 	self 
+ 		keyCharacter: keyCharacter
+ 		atIndex: affectedMorph indexInQuote
+ 		nextFocus: nextFocus!

Item was added:
+ ----- Method: WordGamePanelMorph>>letterMorphs (in category 'access') -----
+ letterMorphs
+ 
+ 	^ letterMorphs!

Item was added:
+ ----- Method: WordGamePanelMorph>>lostFocus (in category 'defaults') -----
+ lostFocus
+ 
+ 	self unhighlight!

Item was added:
+ ----- Method: WordGamePanelMorph>>mouseDownEvent:letterMorph: (in category 'events') -----
+ mouseDownEvent: evt letterMorph: morph
+ 
+ 	haveTypedHere _ false.
+ 	evt hand newKeyboardFocus: morph.
+ 	self highlight: morph!

Item was added:
+ ----- Method: WordGamePanelMorph>>unhighlight (in category 'defaults') -----
+ unhighlight
+ 
+ 	letterMorphs do: [:m | m ifNotNil: [m unhighlight]]
+ !

Item was added:
+ Object subclass: #WordNet
+ 	instanceVariableNames: 'form url args word replyHTML parts partStreams rwStream replyParsed'
+ 	classVariableNames: 'CanTranslateFrom Languages'
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Network-TelNet WordNet'!
+ 
+ !WordNet commentStamp: '<historical>' prior: 0!
+ Query the WordNet lexicon at Princeton Univ.  At http://www.cogsci.princeton.edu/cgi-bin/webwn/   To get the definition of a word, select any word in any text pane, and choose "definition of word" from the shift menu.  WordNet is also used for the "verify spelling of word" menu item.
+ 	Subclasses are interfaces to other dictionaries.  The "choose language" item on the shift-menu lets you select a language (and its server).  (Preferences setPreference: #myLanguage toValue: #Portuguese).
+ 
+ WordNet openScamperOn: 'balloon'.
+ 
+ 
+ DD _ WordNet new.
+ DD definition: 'balloon'.
+ DD parts "of speech".
+ 	 OrderedCollection ('noun' 'verb' )
+ DD sensesFor: 'noun'.
+ 	 2
+ DD def: 1 for: 'noun'.
+ 	 '(large tough non-rigid bag filled with gas or hot air)'
+ After the initial response, keep a separate stream for the definition of each part of speech.  Caller may later query them for information.
+ !

Item was added:
+ ----- Method: WordNet class>>canTranslateFrom (in category 'miscellaneous') -----
+ canTranslateFrom
+ 
+ 	Languages ifNil: [Languages _ #(English Portuguese).
+ 		CanTranslateFrom _ #(French German Spanish English Portuguese 
+ 			Italian Norwegian)].		"see www.freetranslation.com/"
+ 	^ CanTranslateFrom !

Item was added:
+ ----- Method: WordNet class>>definitionsFor: (in category 'services') -----
+ definitionsFor: aWord
+ 	| aDef parts item |
+ 	aDef _ self new.
+ 	(aDef definition: aWord) ifNil:
+ 		[self inform: 'Sorry, cannot reach the WordNet
+ web site; task abandoned.'.
+ 		^ nil].
+ 	parts _ aDef parts.
+ 	parts size = 0 ifTrue:
+ 		[self inform: 'Sorry, ', aWord, ' not found.'.
+ 		^ nil].
+ 
+ 	^ String streamContents:
+ 		[:defStream |
+ 			defStream nextPutAll: aWord; cr.
+ 			parts do:
+ 				[:aPart |
+ 					defStream cr.
+ 					1 to: (aDef sensesFor: aPart) do:
+ 						[:senseNumber |
+ 							defStream nextPutAll: aPart.
+ 							item _ aDef def: senseNumber for: aPart.
+ 							defStream nextPutAll: (' (', senseNumber printString, ') ', (item copyFrom: 2 to: item size - 1)).
+ 							defStream cr]]]
+ 
+ "WordNet definitionsFor: 'balloon'"
+ !

Item was added:
+ ----- Method: WordNet class>>languagePrefs (in category 'miscellaneous') -----
+ languagePrefs
+ 	"Set preference of which natural language is primary. Look up definitions in it, and correct speaLanguageing in it.  Also, let user set languages to translate from and to."
+ 
+ 	| ch aLanguage |
+ 	self canTranslateFrom.		"sets defaults"
+ 	ch _ PopUpMenu withCaption: 'Choose the natural language to use for:'
+ 			chooseFrom: 'word definition and spelling verification (', 
+ 					(Preferences parameterAt: #myLanguage ifAbsentPut: [#English]) asString ,')...\',
+ 				'language to translate FROM   (now ',
+ 					(Preferences parameterAt: #languageTranslateFrom ifAbsentPut: [#English]) asString ,')...\',
+ 				'language to translate TO   (now ',
+ 					(Preferences parameterAt: #languageTranslateTo ifAbsentPut: [#German]) asString ,')...\'.
+ 	ch = 1 ifTrue: [
+ 		aLanguage _ PopUpMenu withCaption: 'The language for word definitions and speaLanguageing verification:'
+ 			chooseFrom: Languages.
+ 		aLanguage > 0 ifTrue:
+ 			[^ Preferences setParameter: #myLanguage to: (Languages at: aLanguage) asSymbol]].
+ 	ch = 2 ifTrue:
+ 		[aLanguage _ PopUpMenu withCaption: 'The language to translate from:'
+ 			chooseFrom: CanTranslateFrom.
+ 		aLanguage > 0 ifTrue:
+ 			[^ Preferences setParameter: #languageTranslateFrom to: (CanTranslateFrom at: aLanguage) asSymbol]].
+ 	ch = 3 ifTrue:
+ 		[aLanguage _ PopUpMenu withCaption: 'The language to translate to'
+ 			chooseFrom: CanTranslateFrom.
+ 		aLanguage > 0 ifTrue:
+ 			[^ Preferences setParameter: #languageTranslateTo to: (CanTranslateFrom at: aLanguage) asSymbol]].
+ 
+ 	"Maybe let the user add another language if he knows the server can take it."
+ "	ch _ (PopUpMenu labelArray: Languages, {'other...'.
+ 			'Choose language to translate from...'})
+ 		startUpWithCaption: 'Choose the language of dictionary for word definitions.'.
+ 	ch = 0 ifTrue: [^ Preferences setParameter: #myLanguage to: #English].
+ 	(ch <= Languages size) ifTrue: [aLanguage _ Languages at: ch].
+ 	ch = (Languages size + 1) ifTrue: [
+ 		aLanguage _ FillInTheBlank request: 'Name of the primary language'].
+ 	aLanguage ifNotNil: [^ Preferences setParameter: #myLanguage to: aLanguage asSymbol].
+ "!

Item was added:
+ ----- Method: WordNet class>>lexiconServer (in category 'miscellaneous') -----
+ lexiconServer
+ 	"Look in Preferences to see what language the user wants, and what class knows about it."
+ 
+ 	| nl |
+ 	nl _ Preferences parameterAt: #myLanguage ifAbsentPut: [#English].
+ 	nl == #English ifTrue: [^ self].		"English, WordNet server"
+ 	nl == #Portuguese ifTrue: [^ PortugueseLexiconServer].	"www.priberam.pt"
+ 
+ "	nl == #Deutsch ifTrue: [^ DeutschServerClass]. "	"class that knows about a server"
+ 
+ 	self inform: 'Sorry, no known online dictionary in that language.'.
+ 	^ self languagePrefs!

Item was added:
+ ----- Method: WordNet class>>openScamperOn: (in category 'miscellaneous') -----
+ openScamperOn: aWord
+ 	| aUrl scamperWindow |
+ 	"Open a Scamper web browser on the WordNet entry for this word.  If Scamper is already pointing at WordNet, use the same browser."
+ 
+ 	aUrl _ 'http://www.cogsci.princeton.edu/cgi-bin/webwn/', 
+ 		'?stage=1&word=', aWord.
+ 	scamperWindow _ (WebBrowser default ifNil: [^self]) newOrExistingOn: aUrl.
+ 	scamperWindow model jumpToUrl: aUrl asUrl.
+ 	scamperWindow activate.
+ !

Item was added:
+ ----- Method: WordNet class>>verify: (in category 'services') -----
+ verify: aWord
+ 	"See if this spelling is in the WordNet lexicon.  Return a string of success, no-such-word, or can't reach the server."
+ 
+ 	| aDef nl |
+ 	aDef _ self new.
+ 	(aDef definition: aWord) ifNil:
+ 		[^ 'Sorry, cannot reach that web site.  Task abandoned.
+ (Make sure you have an internet connection.)'].
+ 	nl _ Preferences parameterAt: #myLanguage ifAbsentPut: [#English].
+ 
+ 	(aDef parts) size = 0 
+ 		ifTrue: [^ 'Sorry, ', aWord, ' not found. (', nl, ' lexicon)']
+ 		ifFalse: [^ aWord, ' is spelled correctly.']!

Item was added:
+ ----- Method: WordNet>>def:for: (in category 'as yet unclassified') -----
+ def: nth for: partOfSpeech
+ 
+ 	| ii strm |
+ 	parts ifNil: [self parts].
+ 	(ii _ parts indexOf: partOfSpeech) = 0 ifTrue: [^ nil].
+ 	strm _ partStreams at: ii.
+ 	strm reset.
+ 	1 to: nth do: [:nn | 
+ 		strm match: '<BR>',(String with: Character lf),nn printString, '.  '.
+ 		strm match: ' -- '].
+ 	^ strm upToAll: '<BR>'!

Item was added:
+ ----- Method: WordNet>>definition: (in category 'as yet unclassified') -----
+ definition: theWord
+ 	"look this word up in the basic way.  Return nil if there is trouble accessing the web site."
+ 	| doc |
+ 	word _ theWord.
+ 	Cursor wait showWhile: [
+ 		doc _ HTTPSocket 
+ 			httpGetDocument: 'http://www.cogsci.princeton.edu/cgi-bin/webwn/' 
+ 			args: 'stage=1&word=', word].
+ 	replyHTML _ (doc isKindOf: MIMEDocument)
+ 		ifTrue:
+ 			[doc content]
+ 		ifFalse:
+ 			[nil].
+ 	"self parseReply."
+ 
+ 	^ replyHTML!

Item was added:
+ ----- Method: WordNet>>partOfSpeech (in category 'as yet unclassified') -----
+ partOfSpeech
+ 
+ 	rwStream ifNil: [self stream].
+ 	rwStream reset.
+ 	rwStream match: '<BR>The <B>'.
+ 	^ rwStream upToAll: '</B>'!

Item was added:
+ ----- Method: WordNet>>partOfSpeechIn: (in category 'as yet unclassified') -----
+ partOfSpeechIn: aStrm
+ 
+ 	aStrm reset.
+ 	aStrm match: '<BR>The <B>'.
+ 	^ aStrm upToAll: '</B>'!

Item was added:
+ ----- Method: WordNet>>parts (in category 'as yet unclassified') -----
+ parts
+ 	"return the parts of speech this word can be.  Keep the streams for each"
+ 	parts _ OrderedCollection new.
+ 	partStreams _ OrderedCollection new.
+ 	rwStream ifNil: [self stream].
+ 	rwStream reset.
+ 	rwStream match: '<HR>'.
+ 	[rwStream atEnd] whileFalse: [
+ 		partStreams add: (ReadStream on: (rwStream upToAll: '<HR>'))].
+ 	partStreams do: [:pp |
+ 		parts add: (self partOfSpeechIn: pp)].
+ 	parts size = 0 ifTrue: [^ parts].
+ 	parts last = '' ifTrue: [parts removeLast.  partStreams removeLast].
+ 	^ parts !

Item was added:
+ ----- Method: WordNet>>senses (in category 'as yet unclassified') -----
+ senses
+ 
+ 	| ww |
+ 	ww _ '"', word, '"'.
+ 	rwStream ifNil: [self stream].
+ 	rwStream reset.
+ 	rwStream match: ww.
+ 	rwStream match: ww.
+ 	rwStream match: ' has '.
+ 	^ (rwStream upTo: Character lf) asNumber!

Item was added:
+ ----- Method: WordNet>>sensesFor: (in category 'as yet unclassified') -----
+ sensesFor: partOfSpeech
+ 
+ 	| ii strm |
+ 	parts ifNil: [self parts].
+ 	(ii _ parts indexOf: partOfSpeech) = 0 ifTrue: [^ nil].
+ 	strm _ partStreams at: ii.
+ 	strm reset.
+ 	strm match: '"', word, '"'.
+ 	strm match: ' has '.
+ 	^ (strm upTo: Character lf) asNumber!

Item was added:
+ ----- Method: WordNet>>stream (in category 'as yet unclassified') -----
+ stream
+ 
+ 	rwStream _  RWBinaryOrTextStream on: (String new: 1000).
+ 	rwStream nextPutAll: replyHTML; reset.
+ 	^ rwStream!

Item was added:
+ ----- Method: Workspace class>>sissCreateInstanceFromSexp:idref:from:to: (in category '*Etoys-Squeakland-instance creation') -----
+ sissCreateInstanceFromSexp: sexp idref: idref from: from to: to
+ 
+ 	| b dict bindings |
+ 	b _ self new.
+ 	idref ifNotNil: [to at: idref put: b].
+ 	dict _ self sissSlotsFromSexp: sexp from: from to: to.
+ 	bindings _ dict at: #bindings ifAbsent: [].
+ 	bindings ifNotNil: [b setBindings: bindings].
+ 	b contents: (dict at: #contents).
+ 	b acceptsDroppingMorphForReference: (dict at: #acceptDroppedMorphs).
+ 	^ b.
+ !

Item was added:
+ ----- Method: Workspace>>bindings (in category '*Etoys-Squeakland-accessing') -----
+ bindings
+ 
+ 	^ bindings
+ !

Item was added:
+ ----- Method: Workspace>>embeddedInMorphicWindowLabeled: (in category '*Etoys-Squeakland-accessing') -----
+ embeddedInMorphicWindowLabeled: labelString
+ 	| window |
+ 	window _ (SystemWindow labelled: labelString) model: self.
+ 	window addMorph: (PluggableTextMorph on: self text: #contents accept: #acceptContents:
+ 			readSelection: nil menu: #codePaneMenu:shifted:)
+ 		frame: (0 at 0 corner: 1 at 1).
+ 	^ window!

Item was added:
+ ----- Method: Workspace>>sissExportSpecification (in category '*Etoys-Squeakland-object fileIn') -----
+ sissExportSpecification
+ 
+ 	^ #(('contents' #sissGetContents)
+ 		('bindings' #bindings)
+ 		('acceptDroppedMorphs' #acceptsDroppingMorphForReference)
+ 	)!

Item was added:
+ ----- Method: Workspace>>sissGetContents (in category '*Etoys-Squeakland-object fileIn') -----
+ sissGetContents
+ 
+ 	| textMorph |
+ 	textMorph _ self dependents detect: [:dep | dep isKindOf: PluggableTextMorph] ifNone: [nil].
+ 	textMorph notNil ifTrue: [^ textMorph textMorph paragraph text].
+ 
+ 	^ ''.
+ !

Item was added:
+ ----- Method: Workspace>>sissSetContents: (in category '*Etoys-Squeakland-object fileIn') -----
+ sissSetContents: aText
+ 
+ 	| textMorph |
+ 	textMorph _ self dependents detect: [:dep | dep isKindOf: PluggableTextMorph] ifNone: [nil].
+ 	textMorph notNil ifTrue: [textMorph setText: aText asText].
+ !

Item was added:
+ Object subclass: #WorldViewModel
+ 	instanceVariableNames: 'initialExtent'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-ST80-Morphic'!
+ 
+ !WorldViewModel commentStamp: '<historical>' prior: 0!
+ Serves as a model for a WorldView -- a morphic world viewed within an mvc project.!

Item was added:
+ ----- Method: WorldViewModel>>fullScreenSize (in category 'user interface') -----
+ fullScreenSize
+ 	"Answer the size to which a window displaying the receiver should be set"
+ 
+ 	^ (0 at 0 extent: DisplayScreen actualScreenSize) copy!

Item was added:
+ ----- Method: WorldViewModel>>initialExtent (in category 'user interface') -----
+ initialExtent
+ 	initialExtent ifNotNil: [^ initialExtent].
+ 	^ super initialExtent!

Item was added:
+ ----- Method: WorldViewModel>>initialExtent: (in category 'as yet unclassified') -----
+ initialExtent: anExtent
+ 	initialExtent _ anExtent!

Item was added:
+ SystemWindow subclass: #WorldWindow
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Worlds'!
+ 
+ !WorldWindow commentStamp: '<historical>' prior: 0!
+ A WorldWindow is a SystemWindow whose central area presents an inner Morphic world.
+ 
+ WorldWindows have a red title bar when the world inside is inactive. This changes to green when the world becomes the active world. The world inside becomes activated by clicking in it. When you click outside this world, the parent world resumes control. While its world is inactive, the WorldWindow may be moved and resized like any other.
+ 
+ It would be nice to make the world inside active whenever the WorldWindow was active, but this presents difficulties in moving and resizing, probably related to use of the global World instead of self world in many methods.
+ 
+ This facility is mainly the work of Bob Arning, with a number of tweaks by DI.
+ !

Item was added:
+ ----- Method: WorldWindow class>>test1 (in category 'as yet unclassified') -----
+ test1
+ 	"WorldWindow test1."
+ 
+ 	| window world |
+ 	world _ WiWPasteUpMorph newWorldForProject: nil.
+ 	window _ (WorldWindow labelled: 'Inner World') model: world.
+ 	window addMorph: world.
+ 	world hostWindow: window.
+ 	window openInWorld
+ !

Item was added:
+ ----- Method: WorldWindow class>>test2 (in category 'as yet unclassified') -----
+ test2
+ 	"WorldWindow test2."
+ 
+ 	| window world scrollPane |
+ 	world _ WiWPasteUpMorph newWorldForProject: nil.
+ 	window _ (WorldWindow labelled: 'Scrollable World') model: world.
+ 	window addMorph: (scrollPane _ TwoWayScrollPane new model: world)
+ 		frame: (0 at 0 extent: 1.0 at 1.0).
+ 	scrollPane scroller addMorph: world.
+ 	world hostWindow: window.
+ 	window openInWorld
+ !

Item was added:
+ ----- Method: WorldWindow>>buildWindowMenu (in category 'menu') -----
+ buildWindowMenu
+ 
+ 	| aMenu |
+ 	aMenu _ super buildWindowMenu.
+ 	{640 at 480. 800 at 600. 832 at 624. 1024 at 768} do: [ :each |
+ 		aMenu 
+ 			add: each x printString,' x ',each y printString 
+ 			target: self 
+ 			selector: #extent: 
+ 			argument: each + (0 at self labelHeight).
+ 	].
+ 	^aMenu!

Item was added:
+ ----- Method: WorldWindow>>collapseOrExpand (in category 'resize/collapse') -----
+ collapseOrExpand
+ 
+ 	super collapseOrExpand.
+ 	isCollapsed ifFalse: [model becomeTheActiveWorldWith: nil]!

Item was added:
+ ----- Method: WorldWindow>>extent: (in category 'geometry') -----
+ extent: x
+ 
+ 	super extent: x.
+ 	model ifNil: [^self].
+ 	model extent: self panelRect extent.!

Item was added:
+ ----- Method: WorldWindow>>fullBounds (in category 'layout') -----
+ fullBounds
+ 
+ 	^self bounds!

Item was added:
+ ----- Method: WorldWindow>>mouseUp: (in category 'event handling') -----
+ mouseUp: evt
+ 
+ 	(self panelRect containsPoint: evt cursorPoint)
+ 		ifTrue: [model becomeTheActiveWorldWith: evt]!

Item was added:
+ ----- Method: WorldWindow>>openInWorld: (in category 'initialization') -----
+ openInWorld: aWorld
+ 	"This msg and its callees result in the window being activeOnlyOnTop"
+ 	self bounds: (RealEstateAgent initialFrameFor: self world: aWorld).
+ 	self firstSubmorph position: (self left + 1) @ (self top + self labelHeight).
+ 	^self openAsIsIn: aWorld!

Item was added:
+ PasteUpMorph subclass: #Worldlet
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Mentoring'!
+ 
+ !Worldlet commentStamp: 'sw 9/19/2006 14:53' prior: 0!
+ An area with a private Presenter, viz, for which the scope of its stop-step-go buttons is limited to the area's interior.!

Item was added:
+ ----- Method: Worldlet>>closeNavigatorFlap (in category 'flaps') -----
+ closeNavigatorFlap
+ 	"Close the navigator flap"
+ 
+ 	(self submorphs
+ 		detect:
+ 			[:m  | (m isKindOf: FlapTab) and: [m flapID = 'Navigator']]
+ 		ifNone:
+ 			[nil])
+ 
+ 	ifNotNilDo:
+ 		[:nav | nav hideFlap]!

Item was added:
+ ----- Method: Worldlet>>initialize (in category 'initialization') -----
+ initialize
+ 	"Initialize the receiver."
+ 
+ 	super initialize.
+ 	self setNameTo: 'screen' translated;
+ 		extent: (700 at 556);  "yeah"
+ 		color: Color white;
+ 		impartPrivatePresenter;
+ 		beSticky;
+ 		borderColor: (Color r: 0.677 g: 0.935 b: 0.484);
+ 		borderWidth: 2. 
+ "
+ Worldlet new openInWorld.
+ "
+ !

Item was added:
+ ----- Method: Worldlet>>installFlaps (in category 'flaps') -----
+ installFlaps
+ 	"Get flaps installed within the bounds of the receiver"
+ 
+ 	| localFlapTabs |
+ 	localFlapTabs := self localFlapTabs.
+ 	localFlapTabs do: [:each | each visible: false].
+ 	localFlapTabs do: [:each |
+ 		each adaptToWorld.
+ 		each visible: true.
+ 		self displayWorld].
+ 	self assureFlapTabsFitOnScreen.
+ 	self bringTopmostsToFront!

Item was added:
+ ----- Method: Worldlet>>paintingFlapTab (in category 'flaps') -----
+ paintingFlapTab
+ 	"If the receiver has a flap which has a paintbox, return it, else return nil"
+ 
+ 	^ nil!

Item was added:
+ ----- Method: XMLNode>>withAllElementsDo: (in category '*Etoys-Squeakland-enumerating') -----
+ withAllElementsDo: aBlock
+ 
+ 	aBlock value: self.
+ !

Item was added:
+ ----- Method: XMLNodeWithElements>>withAllElementsDo: (in category '*Etoys-Squeakland-enumerating') -----
+ withAllElementsDo: aBlock
+ 	aBlock value: self.
+ 	elements
+ 		ifNotNil: [
+ 			self elements do: [:each | each withAllElementsDo: aBlock]]!

Item was added:
+ TransformMorph subclass: #ZoomMorph
+ 	instanceVariableNames: 'fromMorph toMorph boundsSeq finalAction'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Squeakland-Morphic-Widgets'!

Item was added:
+ ----- Method: ZoomMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
+ includeInNewMorphMenu
+ 	"Zooms aren't meaningful without initializations"
+ 	^ false!

Item was added:
+ ----- Method: ZoomMorph>>defaultColor (in category 'initialization') -----
+ defaultColor
+ 	"answer the default color/fill style for the receiver"
+ 	^ Color transparent!

Item was added:
+ ----- Method: ZoomMorph>>step (in category 'stepping and presenter') -----
+ step
+ 
+ 	boundsSeq isEmpty ifTrue:
+ 		["If all done, then grant one final request and vanish"
+ 		finalAction value.
+ 		^ self delete].
+ 
+ 	"Otherwise, zoom to the next rectangle"
+ 	self zoomTo: boundsSeq removeFirst!

Item was added:
+ ----- Method: ZoomMorph>>stepTime (in category 'testing') -----
+ stepTime
+ 
+ 	^ 40!

Item was added:
+ ----- Method: ZoomMorph>>zoomFromMorph:toMorph:andThen: (in category 'as yet unclassified') -----
+ zoomFromMorph: m1 toMorph: m2 andThen: actionBlock
+ 	| nSteps topLeft r2 r1 extent ratio r mouthDeltas |
+ 	fromMorph _ m1.
+ 	toMorph _ m2.
+ 	r1 _ fromMorph fullBounds.
+ 	r2 _ toMorph fullBounds.
+ 	finalAction _ actionBlock.
+ 	nSteps _ 8.
+ 	boundsSeq _ OrderedCollection new.
+ 	r _ (1/nSteps) asFloat.
+ 	ratio _ r.
+ r1 _ 105 at 326 corner: 130 at 348.
+ mouthDeltas _ {-7 at 24. -6 at 21. -6 at 18. -4 at 14. -4 at 10. -3 at 8. -3 at 3. 0 at 0}.
+ 	1 to: nSteps do:
+ 		[:i | topLeft _ ((r2 topLeft - r1 topLeft) * ratio) asIntegerPoint + r1 topLeft.
+ 		extent _ ((r2 extent - r1 extent) * ratio) asIntegerPoint + r1 extent.
+ 		boundsSeq addLast: (topLeft + (mouthDeltas at: i) extent: extent).
+ 		ratio _ ratio + r].
+ 	self addMorph: toMorph.
+ 	self step!

Item was added:
+ ----- Method: ZoomMorph>>zoomTo: (in category 'as yet unclassified') -----
+ zoomTo: newBounds
+ 	| scale |
+ 	self bounds: newBounds.
+ 	scale _ newBounds extent / toMorph fullBounds extent.
+ 	self setOffset: toMorph position - self position angle: 0.0 scale: scale!



More information about the Packages mailing list