[squeak-dev] The Trunk: EToys-bf.94.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Mar 11 00:12:30 UTC 2013


Bert Freudenberg uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-bf.94.mcz

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

Name: EToys-bf.94
Author: bf
Time: 11 March 2013, 1:11:38.945 am
UUID: 4abe21cf-5215-40c9-8371-07b6a9e09b81
Ancestors: EToys-fbs.93

Bring in some classes and methods from the Etoys image so that project loading gives a meaningful error, not just 'unknown class'. See ReleaseBuilderSqueakland>>buildInitialScreen

=============== Diff against EToys-fbs.93 ===============

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-Tile Scriptors'!
  SystemOrganization addCategory: #'Etoys-Widgets'!
  SystemOrganization addCategory: #'Etoys-Tests'!
+ SystemOrganization addCategory: #'Etoys-Support'!

Item was added:
+ Morph subclass: #EToysLauncher
+ 	instanceVariableNames: 'window showGallery'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Experimental'!
+ 
+ !EToysLauncher commentStamp: 'tak 10/18/2006 14:07' prior: 0!
+ I am a simple launcher for recent projects.
+ 
+ EToysLauncher new openInHand
+ 
+ - I find latest ten projects in "My Squeak" and image directories (see: EToysLauncher>>directories).
+ - A thumbnail can be shown if there is "project name.gif" file.
+ - You can enter a project when you click a thumbnail.
+ - The list is updated when you go and back project.
+ 
+ !

Item was added:
+ ----- Method: EToysLauncher class>>buildGallery (in category 'instance creation') -----
+ buildGallery
+ 	"self buildGallery openInHand"
+ 	| launcher panel |
+ 	launcher := self new.
+ 	launcher showGallery: true.
+ 	launcher buildPane.
+ 	panel := ScriptingSystem buildPanelTitled: 'Projects'.
+ 	panel addMorphBack: launcher.
+ 	launcher window: panel.
+ 	^ panel!

Item was added:
+ ----- Method: EToysLauncher class>>buildPanel (in category 'instance creation') -----
+ buildPanel
+ 	"self buildPanel openInHand"
+ 	| launcher panel |
+ 	launcher := self new.
+ 	launcher buildPane.
+ 	panel := ScriptingSystem buildPanelTitled: 'Recent Etoy Projects'.
+ 	panel addMorphBack: launcher.
+ 	launcher window: panel.
+ 	^ panel!

Item was added:
+ ----- Method: EToysLauncher class>>openGallery (in category 'instance creation') -----
+ openGallery
+ 	"self openGallery"
+ 	| window |
+ 	window := self buildGallery.
+ 	window openCenteredInWorld.
+ 	^ window!

Item was added:
+ ----- Method: EToysLauncher class>>openPanel (in category 'instance creation') -----
+ openPanel
+ 	"self openPanel"
+ 	| window |
+ 	window := self buildPanel.
+ 	window openCenteredInWorld.
+ 	^ window!

Item was added:
+ ----- Method: EToysLauncher>>buildButtonFor: (in category 'initialization') -----
+ buildButtonFor: fileName 
+ 	"(self basicNew buildButtonFor: 'new2.001.pr') openInHand"
+ 	"(self basicNew buildButtonFor: 'nothing.pr') openInHand"
+ 	| thumbnail aButton base title projectName |
+ 	projectName := (Project parseProjectFileName: fileName) first.
+ 	base := Morph new.
+ 	base clipSubmorphs: true.
+ 	base color: Color transparent.
+ 	base layoutPolicy: TableLayout new.
+ 	base listDirection: #leftToRight.
+ 	base hResizing: #rigid.
+ 	base vResizing: #shrinkWrap.
+ 	base width: 300.
+ 	base layoutInset: 0.
+ 	base cellInset: 3.
+ 	base beSticky.
+ 	title := StringMorph new.
+ 	title contents: (Project parseProjectFileName: fileName) first.
+ 	title font: Preferences standardEToysFont.
+ 	thumbnail := self thumbnailFor: projectName.
+ 	aButton := IconicButton new labelGraphic: thumbnail.
+ 	aButton target: self.
+ 	aButton actionSelector: #openProjectNamed:.
+ 	aButton arguments: {projectName}.
+ 	aButton borderWidth: 0.
+ 	aButton color: ScriptingSystem baseColor.
+ 	aButton extent: thumbnail extent + (4 @ 4).
+ 	base addMorphBack: aButton.
+ 	base addMorphBack: title.
+ 	^ base!

Item was added:
+ ----- Method: EToysLauncher>>buildPane (in category 'initialization') -----
+ buildPane
+ 	"EToysLauncher new openInHand"
+ 	self color: ScriptingSystem paneColor.
+ 	self layoutPolicy: TableLayout new.
+ 	self cellPositioning: #bottomCenter.
+ 	self listDirection: #leftToRight.
+ 	self wrapDirection: #topToBottom.
+ 	self hResizing: #rigid.
+ 	self vResizing: #shrinkWrap.
+ 	self layoutInset: 6.
+ 	self cellInset: 3.
+ 	self width: 620.
+ 	showGallery ifFalse: [self updatePane] ifTrue: [self updateBook].
+ !

Item was added:
+ ----- Method: EToysLauncher>>directories (in category 'utilities') -----
+ directories
+ 	"I find a project name in this order"
+ 	"self basicNew directories"
+ 	| ret |
+ 	ret := Array with: SecurityManager default untrustedUserDirectory with: Smalltalk imagePath.
+ 	showGallery ifFalse: [^ ret].
+ 	^ ret copyWith: Smalltalk imagePath, FileDirectory slash, 'ExampleEtoys'.
+ !

Item was added:
+ ----- Method: EToysLauncher>>fullPathForProjectNamed: (in category 'utilities') -----
+ fullPathForProjectNamed: projectName 
+ 	"Answer {directory name. file name}"
+ 	"self basicNew fullPathForProjectNamed: 'DemonScript'"
+ 	| entries fileName directory |
+ 	entries := self sortedProjectFiles.
+ 	fileName := (entries
+ 				detect: [:each | (Project parseProjectFileName: each first) first = projectName]) first.
+ 	directory := self directories
+ 				detect: [:each | (FileDirectory on: each)
+ 						includesKey: fileName].
+ 	^ {directory. fileName}!

Item was added:
+ ----- Method: EToysLauncher>>initialize (in category 'initialization') -----
+ initialize
+ 	super initialize.
+ 	showGallery := false.
+ 	"self buildPane."!

Item was added:
+ ----- Method: EToysLauncher>>intoWorld: (in category 'initialization') -----
+ intoWorld: aWorld 
+ 	"World removeActionsForEvent: #aboutToEnterWorld"
+ 	super intoWorld: aWorld.
+ 	aWorld
+ 		when: #aboutToEnterWorld
+ 		send: #onEnterWorld
+ 		to: self!

Item was added:
+ ----- Method: EToysLauncher>>onEnterWorld (in category 'event handling') -----
+ onEnterWorld
+ 	(owner notNil
+ 			and: [World == owner])
+ 		ifTrue: [owner addMorphInLayer: self.
+ 			self updatePane]
+ 		ifFalse: [World removeActionsWithReceiver: self]!

Item was added:
+ ----- Method: EToysLauncher>>openProjectNamed: (in category 'actions') -----
+ openProjectNamed: projectName 
+ 	| newProject array |
+ 	window
+ 		ifNotNil: [window delete].
+ 	(newProject := Project named: projectName)
+ 		ifNil: [array := self fullPathForProjectNamed: projectName.
+ 			ProjectLoading
+ 				openFromDirectory: (FileDirectory on: array first)
+ 				andFileName: array second]
+ 		ifNotNil: [newProject enter]!

Item was added:
+ ----- Method: EToysLauncher>>projectFiles (in category 'utilities') -----
+ projectFiles
+ 	"Answer a collection of file entry. Only recent version is picked up."
+ 	"self basicNew projectFiles"
+ 	| entries |
+ 	entries := self directories
+ 				inject: OrderedCollection new
+ 				into: [:collection :each | 
+ 					collection addAll: (FileDirectory on: each) entries.
+ 					collection].
+ 	^ FileList2 projectOnlySelectionMethod: entries!

Item was added:
+ ----- Method: EToysLauncher>>setupBookPage: (in category 'utilities') -----
+ setupBookPage: aPage
+ 
+ 	aPage color: ScriptingSystem paneColor.
+ 	aPage layoutPolicy: TableLayout new.
+ 	aPage cellPositioning: #bottomCenter.
+ 	aPage listDirection: #leftToRight.
+ 	aPage wrapDirection: #topToBottom.
+ 	aPage hResizing: #rigid.
+ 	aPage vResizing: #shrinkWrap.
+ 	aPage layoutInset: 6.
+ 	aPage cellInset: 3.
+ 	aPage width: 620.
+ 
+ 	aPage setProperty: #transitionSpec toValue: (Array with: 'silence' with: #none with: #none).
+ !

Item was added:
+ ----- Method: EToysLauncher>>showGallery (in category 'accessing') -----
+ showGallery
+ 
+ 	^ showGallery.
+ !

Item was added:
+ ----- Method: EToysLauncher>>showGallery: (in category 'accessing') -----
+ showGallery: aBoolean
+ 
+ 	showGallery := aBoolean.
+ !

Item was added:
+ ----- Method: EToysLauncher>>sortedAllProjectFiles (in category 'utilities') -----
+ sortedAllProjectFiles
+ 	"self basicNew sortedAllProjectFiles"
+ 	| entries |
+ 	entries := self projectFiles asArray
+ 				sort: [:a :b | a modificationTime > b modificationTime].
+ 	^ entries!

Item was added:
+ ----- Method: EToysLauncher>>sortedProjectFiles (in category 'utilities') -----
+ sortedProjectFiles
+ 	"self basicNew sortedProjectFiles"
+ 	| entries |
+ 	entries := self sortedAllProjectFiles.
+ 	showGallery ifTrue: [^ entries].
+ 	^ entries size > 10
+ 		ifTrue: [entries first: 10]
+ 		ifFalse: [entries]!

Item was added:
+ ----- Method: EToysLauncher>>thumbnailFor: (in category 'initialization') -----
+ thumbnailFor: projectName 
+ 	| project thumbnailName newForm array |
+ 	newForm := (project := Project named: projectName)
+ 				ifNil: [array := self fullPathForProjectNamed: projectName.
+ 					thumbnailName := array first , FileDirectory slash , projectName , '.gif'.
+ 					[ImageReadWriter formFromFileNamed: thumbnailName]
+ 						on: FileDoesNotExistException
+ 						do: [^ Form extent: 100 @ 75]]
+ 				ifNotNil: [project thumbnail].
+ 	^ newForm scaledToSize: 100 @ 75!

Item was added:
+ ----- Method: EToysLauncher>>updateBook (in category 'actions') -----
+ updateBook
+ 	| entries fileNames aBookMorph currentPage count base |
+ 	self removeAllMorphs.
+ 	entries := self sortedProjectFiles.
+ 	fileNames := entries
+ 				collect: [:each | each first].
+ 	aBookMorph := BookMorph new.
+ 	aBookMorph extent: self extent.
+ 	self addMorph: aBookMorph.
+ 	currentPage := aBookMorph currentPage..
+ 	self setupBookPage: currentPage.
+ 	count := 0.
+ 	fileNames
+ 		do: [:each |
+ 			currentPage addMorphBack: (self buildButtonFor: each).
+ 			count := count + 1.
+ 			(count \\ 10 = 0) ifTrue: [
+ 				"base := Morph new.
+ 				base width: 300; color: Color transparent; borderWidth: 0.
+ 				currentPage addMorphBack: base.
+ 				currentPage addMorphBack: (RectangleMorph new extent: 100 at 75; color: Color transparent; borderWidth: 0).
+ 				currentPage addMorphBack: (StringMorph new font: Preferences standardEToysFont; contents: 'more...')."
+ 				currentPage := aBookMorph insertPageSilentlyAtEnd.
+ 				self setupBookPage: currentPage.
+ 			]].
+ 	aBookMorph evenFewerPageControlsAllowDragging: false..
+ !

Item was added:
+ ----- Method: EToysLauncher>>updatePane (in category 'actions') -----
+ updatePane
+ 	| entries fileNames |
+ 	self removeAllMorphs.
+ 	entries := self sortedProjectFiles.
+ 	fileNames := entries
+ 				collect: [:each | each first].
+ 	fileNames
+ 		do: [:each | self
+ 				addMorphBack: (self buildButtonFor: each)]!

Item was added:
+ ----- Method: EToysLauncher>>wantsToBeDroppedInto: (in category 'event handling') -----
+ wantsToBeDroppedInto: aMorph 
+ 	(aMorph isKindOf: ProjectViewMorph)
+ 		ifTrue: [^ false].
+ 	^ super wantsToBeDroppedInto: aMorph!

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

Item was added:
+ ----- Method: EToysLauncher>>window: (in category 'accessing') -----
+ window: aMorph
+ 	^ window := aMorph!

Item was added:
+ TileMorph subclass: #FunctionNameTile
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Scripting Tiles'!
+ 
+ !FunctionNameTile commentStamp: 'sw 6/9/2007 22:25' prior: 0!
+ An operator tile holding the name of a function; used in conjunction with a FunctionTile which is always its owner.!

Item was added:
+ ----- Method: FunctionNameTile>>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 operatorList |
+ 	operatorList := self options second.
+ 	index := (operatorList indexOf: self value) + delta.
+ 	self setOperator: (operatorList atWrap: index).
+ 	self scriptEdited.
+ 	self layoutChanged!

Item was added:
+ ----- Method: FunctionNameTile>>grouped (in category 'menu commands') -----
+ grouped
+ 	"The user chose grouped from the menu.  Establish the special-case null function call."
+ 
+ 	self setOperator: #grouped!

Item was added:
+ ----- Method: FunctionNameTile>>operator:wording:helpString: (in category 'initialization') -----
+ operator: anOperator wording: aWording helpString: aHelpString
+ 	"Set the operator as per aString, and add up/down arrows"
+ 
+ 	type := #operator.
+ 	operatorOrExpression := anOperator asSymbol.
+ 	operatorOrExpression = #grouped
+ 		ifTrue:
+ 			[self line1: ' ']
+ 		ifFalse:
+ 			[self line1: aWording].
+ 	self addArrows..
+ 	aHelpString ifNotNil: [submorphs last setBalloonText: aHelpString]!

Item was added:
+ ----- Method: FunctionNameTile>>options (in category 'choice of function') -----
+ options
+ 	"Answer the options of the tile for an arrow"
+ 
+ 	| aTable |
+ 	aTable := ScriptingSystem tableOfNumericFunctions reversed.
+ 
+ 	^ Array with:
+ 				(aTable collect: [:pr | pr first] ), #(grouped)
+ 			with:
+ 				(aTable collect: [:pr | pr second]), #(grouped)!

Item was added:
+ ----- Method: FunctionNameTile>>removeFunction (in category 'menu commands') -----
+ removeFunction
+ 	"Remove the function-call... this is forwarded to owner."
+ 
+ 	^ owner removeFunction!

Item was added:
+ ----- Method: FunctionNameTile>>setOperator: (in category 'choice of function') -----
+ setOperator: anOperatorSymbol
+ 	"The user chose an entry with the given inherent operator symbol (this may differ from what the user sees in the pop-up or on the tile."
+ 
+ 	| aTable |
+ 	operatorOrExpression := anOperatorSymbol.
+ 	operatorOrExpression = #grouped
+ 		ifTrue:
+ 			[self line1: ' '.
+ 			self setBalloonText: 'parenthesized' translated]
+ 		ifFalse:
+ 			[aTable := ScriptingSystem tableOfNumericFunctions.
+ 			(aTable detect: [:m | m second = anOperatorSymbol] ifNone: [nil]) ifNotNilDo:
+ 				[:aTriplet |
+ 					self line1: aTriplet first translated.
+ 					self setBalloonText: aTriplet third translated]].
+ 	self addArrows.
+ 	self scriptEdited.
+ 	self layoutChanged!

Item was added:
+ ----- Method: FunctionNameTile>>showOptions (in category 'choice of function') -----
+ showOptions
+ 	"Put up a pop-up menu of options for the operator tile within me."
+ 
+ 	| aMenu aTable |
+ 	aMenu := MenuMorph new defaultTarget: self.
+ 	aTable := ScriptingSystem tableOfNumericFunctions.
+ 	aTable do:
+ 		[:triplet |
+ 			aMenu add: triplet first translated target: self  selector:  #setOperator: argument: triplet second.
+ 			triplet second = operatorOrExpression ifTrue:
+ 				[aMenu lastItem color: Color red].
+ 			aMenu balloonTextForLastItem: triplet third translated].
+ 
+ 	aMenu addTranslatedList:
+ 		#(-
+ 		('parentheses'  grouped 'enclose within parentheses')) translatedNoop.
+ 	operatorOrExpression = #grouped ifTrue:
+ 		[aMenu lastItem color: Color red].
+ 
+ 	(owner owner isKindOf: TilePadMorph) ifTrue:
+ 		[aMenu addLine.
+ 		operatorOrExpression = #grouped
+ 			ifFalse:			
+ 				[aMenu addTranslatedList:
+ 					#(('remove function' removeFunction  'strip away the function call, leaving just its former argument in its place')) translatedNoop.]
+ 			ifTrue:
+ 				[aMenu addTranslatedList:
+ 					#(('remove parentheses' removeFunction  'strip away the parenthesises')) translatedNoop]].
+ 
+ 	aMenu position: self position.
+ 	aMenu invokeModal
+ !

Item was added:
+ ----- Method: FunctionNameTile>>storeCodeOn:indent: (in category 'code generation') -----
+ storeCodeOn: aStream indent: tabCount 
+ 	"Store the receiver's code on the stream, honoring indentation."
+ 
+ 	operatorOrExpression = #grouped
+ 		ifTrue:
+ 			[aStream nextPutAll: ' yourself']
+ 		ifFalse:
+ 			[super storeCodeOn: aStream indent: tabCount]!

Item was added:
+ ----- Method: FunctionNameTile>>updateLiteralLabel (in category 'updating') -----
+ updateLiteralLabel
+ 	 "Update the wording emblazoned on the tile, if needed"
+ 	| myLabel functionTriplet |
+ 	(myLabel := self labelMorph)
+ 	     ifNil: [^ self].
+ 	operatorOrExpression == #grouped
+ 		ifTrue: [myLabel acceptValue: ' ']
+ 		ifFalse: [functionTriplet := ScriptingSystem tableOfNumericFunctions
+ 						detect: [:triplet | triplet second = operatorOrExpression].
+ 			myLabel acceptValue: functionTriplet first].
+ 	self addArrows.
+ 	self changed!

Item was added:
+ TileMorph subclass: #FunctionTile
+ 	instanceVariableNames: 'functionNameTile argumentPad'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Scripting Tiles'!
+ 
+ !FunctionTile commentStamp: 'sw 6/10/2007 03:41' prior: 0!
+ A scripting tile consisting of a function-name and an argument pad, and representing a call to a numeric function of a single argument.!

Item was added:
+ ----- Method: FunctionTile class>>defaultNameStemForInstances (in category 'scripting') -----
+ defaultNameStemForInstances
+ 	"Answer a good default name stem to use for names of instances"
+ 
+ 	^ 'Function' translatedNoop!

Item was added:
+ ----- Method: FunctionTile class>>randomNumberTile (in category 'scripting') -----
+ randomNumberTile
+ 	"Answer a newly conjured-up random-number tile, suitable for handing to the user."
+ 
+ 	| 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
+ 
+ 
+ "
+ FunctionTile randomNumberTile openInHand
+ "!

Item was added:
+ ----- Method: FunctionTile>>addCustomMenuItems:hand: (in category 'menu') -----
+ addCustomMenuItems: aCustomMenu hand: aHandMorph
+ 	"Add custom menu items to the menu"
+ 
+ 	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ 	self topEditor ifNotNil:
+ 		[aCustomMenu add: 'remove function' translated action: #removeFunctionWrapper]!

Item was added:
+ ----- Method: FunctionTile>>basicParseNodeWith: (in category 'code generation') -----
+ basicParseNodeWith: encoder
+ 	"Answer a message node for the receiver."
+ 
+ 	| sel rec ret |
+ 	sel := submorphs first operatorOrExpression.
+ 	rec := submorphs third parseNodeWith: encoder.
+ 	ret := MessageNode new
+ 				receiver: rec
+ 				selector: sel
+ 				arguments: #()
+ 				precedence: (sel precedence)
+ 				from: encoder
+ 				sourceRange: nil.
+ 	^ self convertPrecedenceInParseNode: ret with: encoder.
+ !

Item was added:
+ ----- Method: FunctionTile>>booleanComparatorPhrase (in category 'dropping/grabbing') -----
+ booleanComparatorPhrase
+ 	"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 rel  |
+ 
+ 	rel := Vocabulary numberVocabulary comparatorForSampleBoolean.
+ 	outerPhrase := PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: #Number argType: #Number.
+ 	outerPhrase firstSubmorph addMorph: self.
+ 	outerPhrase submorphs last addMorph: (ScriptingSystem tileForArgType: #Number).
+ 
+ 	outerPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: rel).    
+ 	^ outerPhrase!

Item was added:
+ ----- Method: FunctionTile>>convertPrecedenceInParseNode:with: (in category 'code generation') -----
+ convertPrecedenceInParseNode: message with: encoder
+ 
+ 	| e r w list |
+ 	w := WriteStream on: (Array new: 3).
+ 	message receiver eToysExpFlattenOn: w.
+ 	list := w contents.
+ 	e := EToyExpressionTransformer2 new newNodeFromList: list encoder: encoder.
+ 	r := e transform.
+ 	message receiver: r.
+ 	^ message.
+ !

Item was added:
+ ----- Method: FunctionTile>>convertPrecedenceOfArgsInParseNode:with: (in category '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: FunctionTile>>initialize (in category 'initialization') -----
+ initialize
+ 	"initialize the state of the receiver"
+ 
+ 	super initialize.
+ 	type := #function.
+ 	self minHeight: 30; vResizing: #spaceFill; borderWidth: 0!

Item was added:
+ ----- Method: FunctionTile>>kedamaParseNodeWith:actualObject: (in category 'code generation') -----
+ kedamaParseNodeWith: encoder actualObject: obj
+ 
+ 	| ret arg |
+ 	arg := submorphs third parseNodeWith: encoder.
+ 	ret := MessageNode new
+ 				receiver: (encoder encodePlayer: obj)
+ 				selector: #random:
+ 				arguments: (Array with: arg)
+ 				precedence: (#random: precedence)
+ 				from: encoder
+ 				sourceRange: nil.
+ 	^  self convertPrecedenceOfArgsInParseNode: ret with: encoder.
+ !

Item was added:
+ ----- Method: FunctionTile>>operator:pad: (in category 'initialization') -----
+ operator: opSymbol pad: aTilePadMorph
+ 	"Set the operator and pad.  Builds and adds the four submorphs of the receiver
+ 		function-name, left-paren, argument-pad, right-paren."
+ 
+ 	| functionTriplet |
+ 	functionTriplet := ScriptingSystem tableOfNumericFunctions  detect: [:triplet | triplet second = opSymbol].  "If none, error..."
+ 	self operator: opSymbol wording: functionTriplet first  translated helpString: functionTriplet third translated pad: aTilePadMorph!

Item was added:
+ ----- Method: FunctionTile>>operator:wording:helpString:pad: (in category 'initialization') -----
+ operator: opSymbol wording: aWording  helpString: aHelpString pad: aTilePadMorph
+ 	"Set the operator and pad.  Builds and adds the four submorphs of the receiver -- function-name, left-paren, argument-pad, right-paren."
+ 
+ 	argumentPad := aTilePadMorph.
+ 	self removeAllMorphs.
+ 	self vResizing: #shrinkWrap.
+ 	functionNameTile := FunctionNameTile new.
+ 	functionNameTile operator: opSymbol wording: aWording helpString: aHelpString.
+ 	self addMorphFront: functionNameTile.
+ 	self addMorphBack: (ImageMorph new image: (ScriptingSystem formAtKey: #LeftParenthesis)).
+ 	self addMorphBack: aTilePadMorph.
+ 	self addMorphBack: (ImageMorph new image: (ScriptingSystem formAtKey: #RightParenthesis))!

Item was added:
+ ----- Method: FunctionTile>>parseNodeWith: (in category 'code generation') -----
+ parseNodeWith: encoder
+ 
+ 	| phrase player costume sel |
+ 	sel := submorphs first operatorOrExpression.
+ 	sel == #random ifFalse: [^ self basicParseNodeWith: encoder].
+ 	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: FunctionTile>>removeFunction (in category 'menu') -----
+ removeFunction
+ 	"Unwrap the receiver from its contents."
+ 
+ 	self removeFunctionWrapper
+ 
+ 	!

Item was added:
+ ----- Method: FunctionTile>>removeFunctionWrapper (in category 'menu') -----
+ removeFunctionWrapper
+ 	"Remove the function wrapper"
+ 	
+ 	| myPad |
+ 	(owner isNil or: [owner owner isNil]) ifTrue: [^ Beeper beep].  "Not in a line of script"
+ 	myPad := submorphs third.
+ 	owner owner replaceSubmorph: owner by: myPad.
+ 	myPad scriptEdited!

Item was added:
+ ----- Method: FunctionTile>>replaceSubmorph:by: (in category 'initialization') -----
+ replaceSubmorph: existingMorph by: newMorph
+ 	"Replace a submorph by a different morph.  If it's my pad, fix up my argumentPad inst var."
+ 
+ 	super replaceSubmorph: existingMorph by: newMorph.
+ 	(newMorph isKindOf: TilePadMorph) ifTrue: [argumentPad := newMorph].
+ !

Item was added:
+ ----- Method: FunctionTile>>rowOfRightTypeFor:forActor: (in category 'dropping/grabbing') -----
+ rowOfRightTypeFor: aLayoutMorph forActor: aPlayer
+ 	"Answer a phrase of the right type for the putative container"
+ 
+ 	| aTemporaryViewer aPhrase |
+ 	aLayoutMorph demandsBoolean ifTrue:
+ 		[aTemporaryViewer := CategoryViewer new invisiblySetPlayer: aPlayer.
+ 		aPhrase := aTemporaryViewer booleanPhraseFromPhrase: self.
+ 		aPhrase justGrabbedFromViewer: false.
+ 		^ aPhrase].
+ 	^ self!

Item was added:
+ ----- Method: FunctionTile>>sexpWith: (in category '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: FunctionTile>>storeCodeOn:indent: (in category 'code generation') -----
+ storeCodeOn: aStream indent: tabCount 
+ 	"Store the receiver's code on the stream, honoring indentation."
+ 
+ 	aStream nextPut: $(.
+ 	aStream space.
+ 	argumentPad storeCodeOn: aStream indent: tabCount.
+ 	aStream nextPut: $).
+ 	aStream space.
+ 	functionNameTile storeCodeOn: aStream indent: tabCount!

Item was added:
+ ----- Method: FunctionTile>>tileRows (in category 'dropping/grabbing') -----
+ tileRows
+ 	"Answer a list of tile rows -- in this case exactly one row -- representing the receiver."
+ 
+ 	^ Array with: (Array with: self)!

Item was added:
+ MorphExtension subclass: #MorphExtensionPlus
+ 	instanceVariableNames: 'layoutProperties layoutPolicy'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Etoys-Support'!
+ 
+ !MorphExtensionPlus commentStamp: 'sw 10/24/2006 05:28' prior: 0!
+ Adds inst vars layoutPolicy and layoutParameters to vanilla MorphExtension, for greater speed and to reduce the need for use of the otherProperties dictionary.!

Item was added:
+ ----- Method: MorphExtensionPlus>>isDefault (in category 'testing') -----
+ isDefault
+ 
+ 	^ super isDefault and: [layoutPolicy isNil and: [layoutProperties isNil]].
+ !

Item was added:
+ ----- Method: MorphExtensionPlus>>layoutPolicy (in category 'accessing') -----
+ layoutPolicy
+ 	"Answer the layout policy."
+ 
+ 	^ layoutPolicy!

Item was added:
+ ----- Method: MorphExtensionPlus>>layoutPolicy: (in category 'accessing') -----
+ layoutPolicy: p
+ 	"Set the layoutPolicy"
+ 
+ 	layoutPolicy := p!

Item was added:
+ ----- Method: MorphExtensionPlus>>layoutProperties (in category 'accessing') -----
+ layoutProperties
+ 	"Answer the layout properties."
+ 
+ 	^ layoutProperties!

Item was added:
+ ----- Method: MorphExtensionPlus>>layoutProperties: (in category 'accessing') -----
+ layoutProperties: p
+ 	"Set the layoutProperties"
+ 
+ 	layoutProperties := p!

Item was added:
+ ----- Method: MorphExtensionPlus>>otherProperties: (in category 'accessing') -----
+ otherProperties: p
+ 	"Set the receiver's otherProperties.  If the argument provided is empty, put nil in its place."
+ 
+ 	otherProperties := p isEmptyOrNil ifTrue: [nil] ifFalse: [p]!

Item was added:
+ ----- Method: MorphExtensionPlus>>printOn: (in category 'printing') -----
+ printOn: aStream 
+ 	"Append to the argument, aStream, a sequence of characters that 
+ 	identifies the receiver." 
+ 
+ 	super printOn: aStream.
+ 	
+ 	layoutPolicy ifNotNil:
+ 		[aStream nextPutAll: ' [layoutPolicy - ', layoutPolicy class name, '] '].
+ 	layoutProperties ifNotNil:
+ 		[aStream nextPutAll: ' [layoutProperties] ']
+ 	!

Item was added:
+ ----- Method: MorphExtensionPlus>>sortedPropertyNames (in category 'accessing - other properties') -----
+ sortedPropertyNames
+ 	"answer the receiver's property names in a sorted way"
+ 
+ 	| props |
+ 	props := WriteStream on: (Array new: 10).
+ 	locked == true ifTrue: [props nextPut: #locked].
+ 	visible == false ifTrue: [props nextPut: #visible].
+ 	sticky == true ifTrue: [props nextPut: #sticky].
+ 	balloonText isNil ifFalse: [props nextPut: #balloonText].
+ 	balloonTextSelector isNil ifFalse: [props nextPut: #balloonTextSelector].
+ 	externalName isNil ifFalse: [props nextPut: #externalName].
+ 	isPartsDonor == true ifTrue: [props nextPut: #isPartsDonor].
+ 	actorState isNil ifFalse: [props nextPut: #actorState].
+ 	player isNil ifFalse: [props nextPut: #player].
+ 	eventHandler isNil ifFalse: [props nextPut: #eventHandler].
+ 	layoutProperties ifNotNil: [props nextPut: #layoutProperties].
+ 	layoutPolicy ifNotNil: [props nextPut: #layoutPolicy].
+ 	self hasOtherProperties 
+ 		ifTrue: [self otherProperties associationsDo: [:a | props nextPut: a key]].
+ 	^props contents sort: [:s1 :s2 | s1 <= s2]!

Item was changed:
  TileMorph subclass: #NumericReadoutTile
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Etoys-Scripting Tiles'!
+ 
+ !NumericReadoutTile commentStamp: 'sw 2/8/2012 18:22' prior: 0!
+ A readout tile for Number-valued variables.
+ If it bears property #PointValued, it will actually represent a Point-valued variable.!

Item was added:
+ ----- Method: ProjectLoading class>>checkSecurity:preStream:projStream: (in category '*etoys') -----
+ checkSecurity: aFileName preStream: preStream projStream: projStream
+ 	"Answer true if passed"
+ 	| trusted enterRestricted |
+ 	trusted := SecurityManager default positionToSecureContentsOf:
+ projStream.
+ 	trusted ifFalse:
+ 		[enterRestricted := (preStream isTypeHTTP or:
+ [aFileName isNil])
+ 			ifTrue: [Preferences securityChecksEnabled]
+ 			ifFalse: [Preferences standaloneSecurityChecksEnabled].
+ 		enterRestricted
+ 			ifTrue: [SecurityManager default enterRestrictedMode
+ 				ifFalse:
+ 					[preStream close.
+ 					^ false]]].
+ 	^ true
+ !

Item was added:
+ ----- Method: ProjectLoading class>>checkStream: (in category '*etoys') -----
+ checkStream: aStream 
+ 	(aStream isNil
+ 			or: [aStream size = 0])
+ 		ifFalse: [^ false].
+ 	ProgressNotification signal: '9999 about to enter
+ project'.
+ 	"the hard part is over"
+ 	self inform: 'It looks like a problem occurred while
+ getting this project. It may be temporary,
+ so you may want to try again,' translated.
+ 	^ true!

Item was added:
+ ----- Method: ProjectLoading class>>fileInName:archive:morphOrList: (in category '*etoys') -----
+ fileInName: aFileName archive: archive morphOrList: morphOrList  
+ 	| baseChangeSet substituteFont numberOfFontSubstitutes exceptions anObject mgr |
+ 	ResourceCollector current: ResourceCollector new.
+ 	baseChangeSet := ChangeSet current.
+ 	self useTempChangeSet.		"named zzTemp"
+ 	"The actual reading happens here"
+ 	substituteFont := Preferences standardEToysFont copy.
+ 	numberOfFontSubstitutes := 0.
+ 	exceptions := Set new.
+ 	[[anObject := morphOrList fileInObjectAndCodeForProject]
+ 		on: FontSubstitutionDuringLoading do: [ :ex |
+ 				exceptions add: ex.
+ 				numberOfFontSubstitutes := numberOfFontSubstitutes + 1.
+ 				ex resume: substituteFont ]]
+ 			ensure: [ ChangeSet  newChanges: baseChangeSet].
+ 	mgr := ResourceManager new initializeFrom: ResourceCollector current.
+ 	mgr fixJISX0208Resource.
+ 	mgr registerUnloadedResources.
+ 	archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: aFileName].
+ 	ResourceCollector current: nil.
+ 	^ {anObject. numberOfFontSubstitutes. substituteFont. mgr}!

Item was added:
+ ----- Method: ProjectLoading class>>loadFromImagePath: (in category '*etoys') -----
+ loadFromImagePath: 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: Smalltalk imagePath.
+ 	entries := FileList2 projectOnlySelectionMethod: directory entries.
+ 	fileName := (entries
+ 		detect: [:each | (Project parseProjectFileName: each name) first = projectName]
+ 		ifNone: [^ self]) name.
+ 	self
+ 		showProgressBarDuring: [ProgressNotification signal: '0'.
+ 			directory := FileDirectory on: Smalltalk imagePath.
+ 			aStream := directory readOnlyFileNamed: fileName.
+ 			self
+ 				loadName: fileName
+ 				stream: aStream
+ 				fromDirectory: directory
+ 				withProjectView: nil]!

Item was added:
+ ----- Method: ProjectLoading class>>loadName:stream:fromDirectory:withProjectView: (in category '*etoys') -----
+ loadName: aFileName stream: preStream fromDirectory: aDirectoryOrNil
+ withProjectView: existingView
+ 
+ 	^ self loadName: aFileName stream: preStream fromDirectory: aDirectoryOrNil
+ withProjectView: existingView clearOriginFlag: false.
+ !

Item was added:
+ ----- Method: ProjectLoading class>>loadName:stream:fromDirectory:withProjectView:clearOriginFlag: (in category '*etoys') -----
+ loadName: aFileName stream: preStream fromDirectory: aDirectoryOrNil
+ withProjectView: existingView clearOriginFlag: clearOriginFlag
+ 	"Reconstitute a Morph from the selected file, presumed to be
+ 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].
+ 	manifests := (archive membersMatching: '*manifest').
+ 	(manifests size = 1 and: [((dict := self parseManifest: manifests first contents) at: 'Project-Format' ifAbsent: []) = 'S-Expression'])
+ 		ifTrue: [^ self loadSexpProjectDict: 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.
+ 		project noteManifestDetailsIn: dict.
+ 		project removeParameter: #sugarProperties.
+ 		SugarPropertiesNotification signal ifNotNilDo: [:props | 
+ 			project keepSugarProperties: props monitor: true].
+ 		clearOriginFlag ifTrue: [project forgetExistingURL].
+ 		ProgressNotification  signal: '0.8'.
+ 		^ project
+ 	].!

Item was added:
+ ----- Method: ProjectLoading class>>morphOrList:stream:fromDirectory:archive: (in category '*etoys') -----
+ morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive
+ 	"Answer morphOrList or nil if problem happened"
+ 	|  projStream localDir morphOrList |
+ 	projStream := archive
+ 		ifNil: [preStream]
+ 		ifNotNil: [self projectStreamFromArchive: archive].
+ 	(self checkSecurity: aFileName preStream: preStream projStream: projStream)
+ 		ifFalse: [^nil].
+ 	localDir := Project squeakletDirectory.
+ 	aFileName ifNotNil: [
+ 		(aDirectoryOrNil isNil or: [aDirectoryOrNil pathName
+ ~= localDir pathName]) ifTrue: [
+ 			localDir deleteFileNamed: aFileName.
+ 			(localDir fileNamed: aFileName) binary
+ 				nextPutAll: preStream contents;
+ 				close.
+ 		].
+ 	].
+ 	morphOrList := projStream asUnZippedStream.
+ 	preStream sleep.		"if ftp, let the connection close"
+ 	^ morphOrList
+ !

Item was added:
+ ----- Method: ProjectLoading class>>parseManifest: (in category '*etoys') -----
+ parseManifest: aString
+ 
+ 	| dict line index key value aStream |
+ 	aStream := aString readStream.
+ 	dict := Dictionary new.
+ 	[(line := aStream nextLine) notNil] whileTrue: [
+ 		index := line indexOf: $:.
+ 		index > 0 ifTrue: [
+ 			key := line copyFrom: 1 to: index - 1.
+ 			value := (line copyFrom: index + 1 to: line size) withBlanksTrimmed.
+ 			dict at: key put: value.
+ 		].
+ 	].
+ 	^ dict.!

Item was added:
+ ----- Method: ProjectLoading class>>showProgressBarDuring: (in category '*etoys') -----
+ showProgressBarDuring: aBlock 
+ 	ProgressInitiationException
+ 		display: 'Loading a Project...'
+ 		from: 0 to: 1
+ 		during: [:bar | aBlock
+ 				on: ProgressNotification
+ 				do: [:e | 
+ 					bar value: e messageText asNumber.
+ 					e resume]].
+ !

Item was changed:
  TileMorph subclass: #RandomNumberTile
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Etoys-Scripting Tiles'!
+ 
+ !RandomNumberTile commentStamp: 'sw 6/24/2007 02:48' prior: 0!
+ Disused; retained "temporarily" for backward compatibility.  The duties formerly served by the RandomNumberTile are now handled by the generic FunctionTile.!

Item was added:
+ ----- Method: ReleaseBuilderSqueakland>>buildInitialScreen (in category '*etoys') -----
+ buildInitialScreen
+ 	"ReleaseBuilderSqueakland new buildInitialScreen"
+ 
+ 	"Work in progress.
+ 	This assumes the Etoys support files are in place, from
+ 		http://etoys.squeak.org/svn/trunk/Etoys/
+ 	Or at least the Home.007.pr file.
+ 	"
+ [
+ 	ProjectLoading loadFromImagePath: 'Home'.
+ ] valueSupplyingAnswer: #('This project was created from a more recent version of Etoys' true).
+ !

Item was added:
+ ----- Method: SmartRefStream>>componentLikeModelbosfcebbmsop0 (in category '*etoys-projects') -----
+ componentLikeModelbosfcebbmsop0
+ 
+ 	^ MorphicModel!

Item was added:
+ ----- Method: SmartRefStream>>currentProjectRefactoringx0 (in category '*etoys-projects') -----
+ currentProjectRefactoringx0
+ 
+ 	^ UndefinedObject!

Item was added:
+ ----- Method: SmartRefStream>>variableSpacerbosfcebb0 (in category '*etoys-projects') -----
+ variableSpacerbosfcebb0
+ 
+ 	^ AlignmentMorph!



More information about the Squeak-dev mailing list