'From Squeakland.396-Nihongo7.29 of 18 March 2005 [latest update: #98] on 5 June 2005 at 8:41:36 pm'!
"Change Set:		SuperPartsBin.cs
Date:			12 January 2005
Author:			Takashi Yamamiya

Super Parts Bin allows you to share morphs among differernt Squeak image.
You can exchange your morph through the internet with SuperSwiki server.
The storage can any server directory like SuperSwiki or local directory.

Do it the code;
SuperPartsBin openAsTab.

My Bin --- Your local directory (Squeaklet).
Public Bin -- Public Swiki Server http://languagegame.no-ip.com/super/

Although Public Bin is a freebsd box in my room, feel free to upload
your nice morph!!
If you want to add your server,
see http://minnow.cc.gatech.edu/squeak/3387
"
!

Object subclass: #PartsBinDirectory
	instanceVariableNames: 'directory directoryEntries index icons isMorphOnly'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SuperPartsBin'!
PartsBin subclass: #SuperPartsBin
	instanceVariableNames: 'directory updateProcess'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SuperPartsBin'!

!SuperPartsBin commentStamp: 'tak 1/12/2005 16:05' prior: 0!
SuperPartsBin openAsTab.
SuperPartsBin destroyFlaps.
!

DirectoryEntry subclass: #SuperPartsBinEntry
	instanceVariableNames: 'form'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SuperPartsBin'!
FlapTab subclass: #SuperPartsBinFlap
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SuperPartsBin'!
TestCase subclass: #SuperPartsBinTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SuperPartsBin'!

!SuperPartsBinTest commentStamp: 'tak 2/18/2005 14:33' prior: 0!
ServerDirectory addServer: (SuperSwikiFileServer new type: #http;
			 server: 'localhost:8888';
			 directory: '/super/SuperSwikiProj';
			 acceptsUploads: true) named: 'Localhost'.

self buildSuite run
!

SuperSwikiServer subclass: #SuperSwikiFileServer
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SuperPartsBin'!

!SuperSwikiFileServer commentStamp: 'tak 1/2/2005 15:15' prior: 0!
I am almost same as SuperSwikiServer, but I am used for file storage not only project.

| server |
server _ SuperSwikiFileServer new type: #http;
		 server: 'squeakalpha.org:8080';
		 directory: '/super/SuperSwikiProj'.
server entries explore.
!

Object subclass: #TileScriptBuilder
	instanceVariableNames: 'morph player viewer'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SuperPartsBin-Support'!

!TileScriptBuilder commentStamp: 'tak 1/12/2005 15:35' prior: 0!
You can build a tile script from a text with me.
I am useful for writing a test case for etoys.!

TestCase subclass: #TileScriptBuilderTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SuperPartsBin-Support'!

!FileDirectory methodsFor: 'file operations' stamp: 'tak 1/12/2005 13:11'!
putFile: file1 named: destinationFileName
	"Copy the contents of the existing fileStream into the file destinationFileName in this directory.  fileStream can be anywhere in the fileSystem."

	| file2 |
	file1 binary.
	(file2 _ self newFileNamed: destinationFileName) ifNil: [^ false].
	file2 binary.
	[self copyFile: file1 toFile: file2]
		ensure: [file2 close].
	file1 close.
	^ true
! !


!Flaps class methodsFor: 'new flap' stamp: 'tak 1/5/2005 20:51'!
newFlapTitled: aString onEdge: anEdge inPasteUp: aPasteUpMorph
	"Add a flap with the given title, placing it on the given edge, in the given pasteup"

	| aFlapBody  aFlapTab |
	aFlapBody _ PasteUpMorph newSticky.
	aFlapTab _ FlapTab new referent: aFlapBody.
	^ self newFlapTitled: aString onEdge: anEdge inPasteUp: aPasteUpMorph tab: aFlapTab
! !

!Flaps class methodsFor: 'new flap' stamp: 'tak 1/5/2005 20:50'!
newFlapTitled: aString onEdge: anEdge inPasteUp: aPasteUpMorph tab: aFlapTab
	"Add a flap with the given title, placing it on the given edge, in the given pasteup"

	| aFlapBody |
	aFlapBody := aFlapTab referent.
	aFlapTab setName: aString edge: anEdge color: (Color r: 0.516 g: 0.452 b: 1.0).

	anEdge == #left ifTrue:
		[aFlapTab position: (aPasteUpMorph left @ aPasteUpMorph top).
		aFlapBody extent: (200 @ aPasteUpMorph height)].
	anEdge == #right ifTrue:
		[aFlapTab position: ((aPasteUpMorph right - aFlapTab width) @ aPasteUpMorph top).
		aFlapBody extent: (200 @ aPasteUpMorph height)].
	anEdge == #top ifTrue:
		[aFlapTab position: ((aPasteUpMorph left + 50) @ aPasteUpMorph top).
		aFlapBody extent: (aPasteUpMorph width @ 200)].
	anEdge == #bottom ifTrue:
		[aFlapTab position: ((aPasteUpMorph left + 50) @ (aPasteUpMorph bottom - aFlapTab height)).
		aFlapBody extent: (aPasteUpMorph width @ 200)].

	aFlapBody beFlap: true.
	aFlapBody color: self defaultColorForFlapBackgrounds.

	^ aFlapTab! !

!Flaps class methodsFor: 'new flap' stamp: 'tak 1/5/2005 20:53'!
newSuperPartsBinFlapTitled: aString onEdge: anEdge inPasteUp: aPasteUpMorph 
	| aFlapBody aFlapTab |
	aFlapBody := SuperPartsBin newSticky.
	aFlapTab := SuperPartsBinFlap new referent: aFlapBody.
	^ self
		newFlapTitled: aString
		onEdge: anEdge
		inPasteUp: aPasteUpMorph
		tab: aFlapTab! !


!Morph methodsFor: 'fileIn/out' stamp: 'tak 1/12/2005 13:53'!
saveOn: aStream 
	self
		allMorphsDo: [:m | m prepareToBeSaved].
	aStream fileOutClass: nil andObject: self! !


!MorphTest methodsFor: 'testing - file in/file out' stamp: 'tak 1/12/2005 11:26'!
testSave
	"self debug: #testSave"
	"New morph should be different name of orignal, but not yet..."
	| stream try result world |
	stream _ MultiByteBinaryOrTextStream on: (ByteArray new).
	world _ PasteUpMorph new.
	try _ Morph new setNameTo: 'Saved Morph'.
	world addMorph: try.
	try saveOn: stream.
	stream reset.
	result _ stream fileInObjectAndCode.
	world addMorph: result.
	self assert: result externalName = 'Saved Morph'! !

!MorphTest methodsFor: 'testing - file in/file out' stamp: 'tak 1/12/2005 11:26'!
testSaveWithScript
	"self debug: #testSaveWithScript"
	"New morph should be different name of orignal, but not yet..."
	| stream try result builder |
	stream _ MultiByteBinaryOrTextStream on: (ByteArray new).
	try _ Morph new.
	builder _ TileScriptBuilder new morph: try.
	builder script: #testScript tile: #((self forward: 10) (self turn: 30)).
	try saveOn: stream.
	stream reset.
	result _ stream fileInObjectAndCode.
	self assert: (result player class scripts includesKey: #testScript).! !


!PartsBinDirectory methodsFor: 'initialize-release' stamp: 'tak 1/25/2005 00:59'!
initialize
	super initialize.
	isMorphOnly := false! !

!PartsBinDirectory methodsFor: 'initialize-release' stamp: 'tak 1/11/2005 23:46'!
on: aDirectory 
	directory _ aDirectory class == SuperSwikiServer
				ifTrue: [SuperSwikiFileServer newFrom: aDirectory]
				ifFalse: [aDirectory]! !

!PartsBinDirectory methodsFor: 'initialize-release' stamp: 'tak 2/18/2005 14:42'!
releaseCachedState
	icons := nil.
	directoryEntries := nil! !

!PartsBinDirectory methodsFor: 'accessing' stamp: 'tak 1/2/2005 23:50'!
add: aMorph 
	self saveMorph: aMorph.
	self saveIcon: aMorph! !

!PartsBinDirectory methodsFor: 'accessing' stamp: 'tak 1/7/2005 13:53'!
atEnd
	^ directoryEntries size < index! !

!PartsBinDirectory methodsFor: 'accessing' stamp: 'tak 1/2/2005 23:20'!
directory
	^ directory! !

!PartsBinDirectory methodsFor: 'accessing' stamp: 'tak 1/7/2005 13:52'!
entries
	| entries |
	entries := OrderedCollection new.
	self open.
	[self atEnd]
		whileFalse: [entries add: self nextEntry].
	^ entries! !

!PartsBinDirectory methodsFor: 'accessing' stamp: 'tak 1/25/2005 01:00'!
isMorphOnly
	^ isMorphOnly! !

!PartsBinDirectory methodsFor: 'accessing' stamp: 'tak 1/25/2005 01:00'!
isMorphOnly: aBoolean 
	isMorphOnly := aBoolean! !

!PartsBinDirectory methodsFor: 'accessing' stamp: 'tak 1/7/2005 14:42'!
nextEntry
	"(Delay forMilliseconds: 10) wait."
	| entry iconEntry |
	entry := directoryEntries at: index.
	index := index + 1.
	icons
		ifNil: [icons := Dictionary new].
	iconEntry := ((icons includesKey: entry name)
					and: [(icons at: entry name) first >= entry modificationTime])
				ifTrue: [icons at: entry name]
				ifFalse: [icons at: entry name put: {entry modificationTime. self privateIconNamed: entry}].
	entry form: iconEntry second.
	^ entry! !

!PartsBinDirectory methodsFor: 'accessing' stamp: 'tak 1/25/2005 01:06'!
open
	| entries entriesMap |
	entries := directory entries
				select: [:each | 
					| isOK | 
					isOK := SuperPartsBinEntry isValidName: each name.
					(isMorphOnly
							and: [(SuperPartsBinEntry typeOfName: each name)
									~~ #morph])
						ifTrue: [isOK := false].
					isOK]
				thenCollect: [:each | SuperPartsBinEntry
						name: each name
						creationTime: each creationTime
						modificationTime: each modificationTime
						isDirectory: each isDirectory
						fileSize: each fileSize].
	entriesMap := Dictionary new.
	(entries
		asSortedCollection: [:x :y | x modificationTime > y modificationTime])
		do: [:each | entriesMap at: each externalName put: each].
	entries := entriesMap values
				asSortedCollection: [:x :y | x modificationTime > y modificationTime].
	index := 1.
	directoryEntries := entries! !

!PartsBinDirectory methodsFor: 'accessing' stamp: 'tak 1/7/2005 15:50'!
privateIconNamed: entry 
	| stream form |
	stream := [directory readOnlyFileNamed: entry formName]
				on: Error
				do: [^ nil].
	stream
		ifNil: [^ nil].
	[form := Form fromBinaryStream: stream]
		ensure: [stream close].
	^ entry type = #project
		ifTrue: [self makeIcon: form]
		ifFalse: [form]! !

!PartsBinDirectory methodsFor: 'accessing' stamp: 'tak 1/3/2005 00:08'!
putFile: morphStream named: fileName 
	[directory putFile: morphStream named: fileName]
		on: FileExistsException
		do: [:e | 
			directory
				deleteFileNamed: fileName
				ifAbsent: [self error: 'Could not delete the old version of that file'].
			directory putFile: morphStream named: fileName]! !

!PartsBinDirectory methodsFor: 'actions' stamp: 'tak 1/7/2005 09:58'!
makeIcon: aForm 
	| aThumbnail |
	aThumbnail := Thumbnail new.
	aThumbnail makeThumbnailFromForm: aForm.
	^ aThumbnail imageFormDepth: 32! !

!PartsBinDirectory methodsFor: 'actions' stamp: 'tak 1/11/2005 23:24'!
morphNamed: aString 
	| stream source sourceStream |
	stream _ directory readOnlyFileNamed: aString , '.morph'.
	[stream binary.
	source _ stream contents]
		ensure: [stream close].
	sourceStream _ MultiByteBinaryOrTextStream with: source.
	sourceStream converter: UTF8TextConverter new.
	sourceStream reset.
	[^ sourceStream fileInObjectAndCode]
		ensure: [stream close]! !

!PartsBinDirectory methodsFor: 'actions' stamp: 'tak 1/11/2005 23:28'!
openEntry: entry 
	| morph |
	entry type = #morph
		ifTrue: [morph _ self morphNamed: entry externalName.
			morph
				setNameTo: (ActiveWorld unusedMorphNameLike: entry externalName).
			morph setProperty: #beFullyVisibleAfterDrop toValue: true.
			morph openInHand].
	entry type = #project
		ifTrue: [ProjectLoading
				installRemoteNamed: entry name
				from: directory
				named: entry externalName
				in: Project current]! !

!PartsBinDirectory methodsFor: 'actions' stamp: 'tak 1/7/2005 09:59'!
saveIcon: aMorph 
	| image gifStream iconName |
	image := self
				makeIcon: (aMorph imageFormDepth: 32).
	gifStream := RWBinaryOrTextStream on: ByteArray new.
	GIFReadWriter putForm: image onStream: gifStream.
	gifStream reset.
	gifStream text.
	iconName := aMorph externalName , '.morph.gif'.
	self putFile: gifStream named: iconName! !

!PartsBinDirectory methodsFor: 'actions' stamp: 'tak 1/11/2005 23:19'!
saveMorph: aMorph 
	| fileName morphStream storeStream |
	aMorph delete.
	fileName := aMorph externalName , '.morph'.
	morphStream := MultiByteBinaryOrTextStream on: ByteArray new.
	morphStream converter: UTF8TextConverter new.
	aMorph saveOn: morphStream.
	storeStream _ morphStream reset binary contents asString readStream.
	self putFile: storeStream named: fileName! !


!PartsBinDirectory class methodsFor: 'instance creation' stamp: 'tak 1/6/2005 16:11'!
named: aString 
	"Anser my instance named a string"
	| dir |
	dir := PartsBinDirectory sourceDirectories at: aString.
	(dir isKindOf: FileDirectory)
		ifTrue: [dir assureExistence].
	^ self on: dir! !

!PartsBinDirectory class methodsFor: 'instance creation' stamp: 'tak 1/2/2005 16:52'!
on: aDirectory
	^ self new on: aDirectory! !

!PartsBinDirectory class methodsFor: 'accessing' stamp: 'tak 6/5/2005 20:40'!
sourceDirectories
	"self sourceDirectories"
	| directories |
	directories := Dictionary new.
	ServerDirectory servers
		keysAndValuesDo: [:key :server | server acceptsUploads
				ifTrue: [directories at: key put: server]].
	directories at: 'My Bin' put: Project squeakletDirectory.
	ServerDirectory localProjectDirectories
		do: [:directory | directories at: directory localName put: directory].
	^ directories! !

!PartsBinDirectory class methodsFor: 'class initialization' stamp: 'tak 2/18/2005 14:56'!
initialize
	"self initialize"
	ServerDirectory addServer: (SuperSwikiServer new type: #http;
			 server: 'languagegame.no-ip.com';
			 directory: '/super/SuperSwikiProj';
			 acceptsUploads: true) named: 'Public Bin'.
	'My Bin' translated.
	'Public Bin' translated.
! !


!ReadWriteStream methodsFor: 'properties-setting' stamp: 'tak 1/2/2005 13:03'!
setFileTypeToObject
	"do nothing.  We don't have a file type"! !


!SuperPartsBin methodsFor: 'accessing' stamp: 'tak 1/6/2005 16:16'!
directory
	^ directory! !

!SuperPartsBin methodsFor: 'accessing' stamp: 'tak 1/7/2005 10:28'!
open: entry 
	Cursor wait
		showWhile: [^ directory openEntry: entry]! !

!SuperPartsBin methodsFor: 'updating' stamp: 'tak 2/20/2005 12:10'!
contentsChanged
	(updateProcess notNil
			and: [updateProcess isTerminated not])
		ifTrue: [^ self].
	updateProcess := [self updateIcons.
			updateProcess := nil] fork! !

!SuperPartsBin methodsFor: 'initialization' stamp: 'tak 1/7/2005 15:51'!
directoryNamed: aString 
	directory := PartsBinDirectory named: aString.
	updateProcess
		ifNotNil: [updateProcess terminate.
			updateProcess := nil].
	self removeAllMorphs.
	self contentsChanged! !

!SuperPartsBin methodsFor: 'initialization' stamp: 'tak 1/2/2005 21:37'!
initialize
	super initialize.
	self layoutPolicy: TableLayout new.
	self listDirection: #leftToRight.
	self wrapCentering: #topLeft.
	self vResizing: #rigid.
	self hResizing: #spaceFill.
	self wrapDirection: #topToBottom.
	self layoutInset: 2.
	self cellPositioning: #bottomCenter! !

!SuperPartsBin methodsFor: 'initialization' stamp: 'tak 1/2/2005 22:29'!
on: aDirectory 
	self changeDirectory: aDirectory! !

!SuperPartsBin methodsFor: 'initialization' stamp: 'tak 2/18/2005 14:49'!
releaseCachedState
	super releaseCachedState.
	updateProcess
		ifNotNil: [updateProcess terminate].
	updateProcess := nil! !

!SuperPartsBin methodsFor: 'initialization' stamp: 'tak 1/7/2005 14:37'!
updateIcons
	| entry aButton |
	[directory open]
		on: NameLookupFailure
		do: [^ self].
	WorldState
		addDeferredUIMessage: [self removeAllMorphs].
	[directory atEnd]
		whileFalse: [entry := directory nextEntry.
			aButton := IconicButton new
						initializeWithThumbnail: entry form asMorph
						withLabel: entry externalName
						andColor: self color
						andSend: nil
						to: nil.
			aButton target: self;
				 actionSelector: #open:;
				 arguments: {entry}.
			WorldState
				addDeferredUIMessage: (MessageSend
						receiver: self
						selector: #addMorphBack:
						argument: aButton)]! !

!SuperPartsBin methodsFor: 'dropping/grabbing' stamp: 'tak 1/3/2005 00:18'!
acceptDroppingMorph: dropped event: evt 
	dropped formerOwner: nil.
	dropped formerPosition: nil.
	dropped removeProperty: #undoGrabCommand.
	Cursor write
		showWhile: [directory add: dropped].
	self contentsChanged.
	^ false! !

!SuperPartsBin methodsFor: 'e-toy support' stamp: 'tak 1/6/2005 16:32'!
adaptToWorld: aWorld
	self contentsChanged.
	super adaptToWorld: aWorld
! !


!SuperPartsBin class methodsFor: 'accessing' stamp: 'tak 1/6/2005 16:00'!
buttons: partsBin 
	| buttons |
	buttons := OrderedCollection new.
	PartsBinDirectory directories
		keysAndValuesDo: [:key :value | buttons add: (SimpleButtonMorph new label: key;
					 actWhen: #buttonDown;
					 target: partsBin;
					 actionSelector: #changeDirectory:;
					 arguments: {value})].
	^ buttons! !

!SuperPartsBin class methodsFor: 'accessing' stamp: 'tak 1/3/2005 00:29'!
newStandAlone
	^ self objectCatalog! !

!SuperPartsBin class methodsFor: 'accessing' stamp: 'tak 1/6/2005 16:56'!
objectCatalog
	"This method doesn't worl yet"
	"self objectCatalog openInHand"
	| base partsBin tabsPane |
	base := AlignmentMorph new.
	base setNameTo: 'Super Parts Bin'.
	base layoutInset: 6;
		 layoutPolicy: ProportionalLayout new;
		 useRoundedCorners;
		 hResizing: #rigid;
		 vResizing: #rigid;
		 extent: 200 @ 300.
	partsBin := self new.
	tabsPane := self tabsPaneFor: partsBin.
	base
		addMorph: tabsPane
		fullFrame: (LayoutFrame
				fractions: (0 @ 0 corner: 1 @ 0)
				offsets: (0 @ 0 corner: 0 @ tabsPane height)).
	base
		addMorph: partsBin
		fullFrame: (LayoutFrame
				fractions: (0 @ 0 corner: 1 @ 1)
				offsets: (0 @ tabsPane height corner: 0 @ 0)).
	^ base! !

!SuperPartsBin class methodsFor: 'accessing' stamp: 'tak 1/2/2005 22:48'!
tabsPaneFor: partsBin 
	| tabsPane row |
	row := AlignmentMorph newRow
				listDirection: #leftToRight;
				wrapDirection: #topToBottom;
				vResizing: #spaceFill;
				hResizing: #spaceFill;
				cellInset: 6;
				layoutInset: 4;
				listCentering: #center;
				listSpacing: #equal;
				yourself.

	tabsPane := Morph new setNameTo: 'TabPane';
				 hResizing: #spaceFill;
				addMorph: row;
				color: Color transparent;
				 yourself.
	(self buttons: partsBin)
		do: [:e | row addMorph: e].
	row width: 200.
	^ tabsPane! !

!SuperPartsBin class methodsFor: 'initialize-release' stamp: 'tak 1/12/2005 16:05'!
destroyFlaps
	"self destroyFlaps"
	(World submorphs
		select: [:each | each isKindOf: SuperPartsBinFlap])
		do: [:flap | flap isGlobalFlap
				ifTrue: [Flaps removeFlapTab: flap keepInList: false.
					flap currentWorld reformulateUpdatingMenus]
				ifFalse: [flap referent isInWorld
						ifTrue: [flap referent delete].
					flap delete]]! !

!SuperPartsBin class methodsFor: 'initialize-release' stamp: 'rak 2/20/2005 23:17'!
initialize
	"self initialize"
	Smalltalk addToStartUpList: self.
	Smalltalk addToShutDownList: self.
! !

!SuperPartsBin class methodsFor: 'initialize-release' stamp: 'tak 1/12/2005 16:07'!
openAsTab
	"self openAsTab"
	| tab spec key color yPos |
	spec := {{'My Bin'. Color r: 0.9 g: 0.6 b: 0.3. 0}.
			{'Public Bin'. Color r: 1 g: 0.8 b: 0.1. 100}}.
	spec
		do: [:each | 
			key := each first.
			color := each second.
			yPos := each third.
			tab := Flaps
						newSuperPartsBinFlapTitled: key
						onEdge: #left
						inPasteUp: World.
			tab fillStyle: color.
			tab y: yPos.
			tab directoryNamed: key.
			World addMorphFront: tab.
			tab adaptToWorld: World.
			Flaps addGlobalFlap: tab.
			tab currentWorld addGlobalFlaps].
	Flaps enableGlobalFlaps! !

!SuperPartsBin class methodsFor: 'initialize-release' stamp: 'tak 2/18/2005 14:56'!
shutDown
	"self shutDown"
	self allSubInstances
		do: [:each | each removeAllMorphs].
	PartsBinDirectory allInstances
		do: [:each | each releaseCachedState]! !

!SuperPartsBin class methodsFor: 'initialize-release' stamp: 'rak 2/20/2005 23:28'!
startUp
	"Refresh local directory"
	"self startUp"
	(SuperPartsBinFlap allInstances
		select: [:each | each labelString = 'My Bin'])
		do: [:each | each directoryNamed: 'My Bin']! !


!SuperPartsBinEntry methodsFor: 'accessing' stamp: 'tak 1/7/2005 16:21'!
externalName
	self type = #morph
		ifTrue: [^ self name allButLast: 6].
	self type = #project
		ifTrue: [^ self name allButLast: 7].
	^ ''! !

!SuperPartsBinEntry methodsFor: 'accessing' stamp: 'tak 1/7/2005 15:58'!
form
	^ form
		ifNil: [ScriptingSystem formAtKey: #Cat]! !

!SuperPartsBinEntry methodsFor: 'accessing' stamp: 'tak 1/7/2005 08:51'!
form: aForm
	form _ aForm! !

!SuperPartsBinEntry methodsFor: 'accessing' stamp: 'tak 1/7/2005 16:21'!
formName
	self type = #morph
		ifTrue: [^ self name , '.gif'].
	self type = #project
		ifTrue: [^ (self name allButLast: 7)
				, '.gif'].
	^ ''! !

!SuperPartsBinEntry methodsFor: 'accessing' stamp: 'tak 1/7/2005 09:27'!
isValid
	^ self externalName isEmpty not! !

!SuperPartsBinEntry methodsFor: 'accessing' stamp: 'tak 1/7/2005 10:00'!
type
	^ self class typeOfName: name! !


!SuperPartsBinEntry class methodsFor: 'testing' stamp: 'tak 1/7/2005 09:35'!
isValidName: aString
	"self isValidName: 'test.morph'"
	"self isValidName: 'henachoko.xx'"
	^ (self typeOfName: aString) notNil! !

!SuperPartsBinEntry class methodsFor: 'testing' stamp: 'tak 1/7/2005 09:34'!
typeOfName: aString 
	"self typeOfName: 'test.morph'"
	"self typeOfName: 'test.002.pr'"
	(aString size > 6
			and: [(aString last: 6)
					= '.morph'])
		ifTrue: [^ #morph].
	(aString size > 7
			and: ['.###.pr'
					match: (aString last: 7)])
		ifTrue: [^ #project].
	^ nil! !


!SuperPartsBinFlap methodsFor: 'accessing' stamp: 'tak 1/6/2005 16:07'!
directoryNamed: aString 
	self referent directoryNamed: aString.
	self changeTabText: aString! !

!SuperPartsBinFlap methodsFor: 'accessing' stamp: 'tak 1/25/2005 01:15'!
toggleIsMorphOnly
	referent directory isMorphOnly: referent directory isMorphOnly not.
	referent contentsChanged! !

!SuperPartsBinFlap methodsFor: 'menu' stamp: 'tak 1/25/2005 01:11'!
addCustomMenuItems: aCustomMenu hand: aHandMorph 
	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	self addIsMorphOnlyOptionMenu: aCustomMenu.
	self addSelectDirectoryMenu: aCustomMenu! !

!SuperPartsBinFlap methodsFor: 'menu' stamp: 'tak 1/25/2005 01:15'!
addIsMorphOnlyOptionMenu: aCustomMenu 
	| toggle |
	toggle := referent directory isMorphOnly
				ifTrue: ['<on>']
				ifFalse: ['<off>'].
	aCustomMenu add: toggle, 'show morph only' translated action: #toggleIsMorphOnly! !

!SuperPartsBinFlap methodsFor: 'menu' stamp: 'tak 1/25/2005 01:07'!
addSelectDirectoryMenu: aCustomMenu 
	| menu |
	menu := MenuMorph new defaultTarget: self.
	PartsBinDirectory sourceDirectories
		keysAndValuesDo: [:key :server | 
			menu
				add: key translated
				target: self
				selector: #directoryNamed:
				argument: key.
			menu balloonTextForLastItem: server pathName].
	aCustomMenu add: 'select directory' translated subMenu: menu! !

!SuperPartsBinFlap methodsFor: 'menu' stamp: 'tak 1/6/2005 16:46'!
fillStyle: fillStyle 
	| thisColor |
	super fillStyle: fillStyle.
	thisColor := self color.
	self referent
		color: (Color
				r: thisColor red
				g: thisColor green
				b: thisColor blue
				alpha: thisColor alpha * 0.8)! !


!SuperPartsBinFlap class methodsFor: 'initialize-release' stamp: 'tak 1/6/2005 17:20'!
destroyFlaps
	"self destroyFlaps"
	(World submorphs
		select: [:each | each isKindOf: self])
		do: [:flap | flap isGlobalFlap
				ifTrue: [Flaps removeFlapTab: flap keepInList: false.
					flap currentWorld reformulateUpdatingMenus]
				ifFalse: [flap referent isInWorld
						ifTrue: [flap referent delete].
					flap delete]]! !


!SuperPartsBinTest methodsFor: 'Accessing' stamp: 'tak 1/12/2005 00:00'!
isConnected
	"self basicNew isConnected"
	^ ('error*' match: self server url asUrl retrieveContents contents) not! !

!SuperPartsBinTest methodsFor: 'Accessing' stamp: 'tak 1/11/2005 18:53'!
scriptSimbol
	"self basicNew scriptSimbol"
	^ ((#(20984006 20983993 20984008 )
		collect: [:e | Character value: e])
		as: String) asSymbol! !

!SuperPartsBinTest methodsFor: 'Accessing' stamp: 'tak 1/11/2005 23:42'!
server
	^ SuperSwikiServer new type: #http;
		 server: 'localhost:8888';
		 directory: '/super/SuperSwikiProj'! !

!SuperPartsBinTest methodsFor: 'Running' stamp: 'tak 1/6/2005 16:12'!
setUp
	FileDirectory default assureExistenceOfPath: 'SuperObjectCatalog'! !

!SuperPartsBinTest methodsFor: 'Running' stamp: 'tak 1/6/2005 16:12'!
tearDown
	(FileDirectory default directoryNamed: 'SuperObjectCatalog') recursiveDelete! !

!SuperPartsBinTest methodsFor: 'testing' stamp: 'tak 1/11/2005 21:56'!
testAdd
	"self debug: #testAdd"
	| dir morph |
	dir _ PartsBinDirectory on: (FileDirectory default directoryNamed: 'SuperObjectCatalog').
	morph _ Morph new setNameTo: 'MORPH'.
	dir add: morph.
	self assert: dir entries first externalName = 'MORPH'.
	self assert: (dir entries first form isKindOf: Form).
	self assert: (dir morphNamed: 'MORPH') externalName = 'MORPH'.! !

!SuperPartsBinTest methodsFor: 'testing' stamp: 'tak 1/11/2005 21:56'!
testAddWithMultiByte
	"self debug: #testAddWithMultiByte"
	| dir morph builder |
	dir _ PartsBinDirectory on: (FileDirectory default directoryNamed: 'SuperObjectCatalog').
	morph _ Morph new setNameTo: 'MORPH'.
	builder _ TileScriptBuilder new morph: morph.
	builder script: self scriptSimbol tile: #((self forward: 10) (self turn: 30)).
	dir add: morph.
	self assert: ((dir morphNamed: 'MORPH') player respondsTo: self scriptSimbol).
! !

!SuperPartsBinTest methodsFor: 'testing' stamp: 'tak 1/12/2005 00:01'!
testAddWithMultiByteOnSwiki
	"self debug: #testAddWithMultiByteOnSwiki"
	| dir morph builder name |
	self isConnected ifFalse: [^self].
	dir := PartsBinDirectory on: self server.
	name _ Time now asSeconds asString.
	morph _ Morph new setNameTo: name.
	builder _ TileScriptBuilder new morph: morph.
	builder script: self scriptSimbol tile: #((self forward: 10) (self turn: 30)).
	dir add: morph.
	self assert: ((dir morphNamed: name) player respondsTo: self scriptSimbol).

! !

!SuperPartsBinTest methodsFor: 'testing' stamp: 'tak 1/11/2005 21:56'!
testAddWithScript
	"self debug: #testAddWithScript"
	| dir morph builder |
	dir _ PartsBinDirectory on: (FileDirectory default directoryNamed: 'SuperObjectCatalog').
	morph _ Morph new setNameTo: 'MORPH'.
	builder _ TileScriptBuilder new morph: morph.
	builder script: #testScript tile: #((self forward: 10) (self turn: 30)).
	dir add: morph.
	self assert: ((dir morphNamed: 'MORPH') player respondsTo: #testScript).
! !

!SuperPartsBinTest methodsFor: 'testing' stamp: 'tak 1/6/2005 16:17'!
testChangeDirectory
	"self debug: #testChangeDirectory"
	| bin |
	bin := SuperPartsBin new.
	bin directoryNamed: 'My Bin'.
	self assert: bin directory directory pathName = (PartsBinDirectory sourceDirectories at: 'My Bin') pathName! !

!SuperPartsBinTest methodsFor: 'testing' stamp: 'tak 1/7/2005 09:28'!
testEntry
	"self debug: #testEntry"
	| e |
	e := SuperPartsBinEntry
				name: 'test.morph'
				creationTime: 0
				modificationTime: 0
				isDirectory: false
				fileSize: 0.
	self assert: e externalName = 'test'.
	self assert: e formName = 'test.morph.gif'.
	e := SuperPartsBinEntry
				name: 'NewCarTutorial.002.pr'
				creationTime: 0
				modificationTime: 0
				isDirectory: false
				fileSize: 0.
	self assert: e externalName = 'NewCarTutorial'.
	self assert: e formName = 'NewCarTutorial.gif'.
	e := SuperPartsBinEntry
				name: 'test.morph.gif'
				creationTime: 0
				modificationTime: 0
				isDirectory: false
				fileSize: 0.
	self assert: e isValid not.
! !

!SuperPartsBinTest methodsFor: 'testing' stamp: 'tak 1/12/2005 00:02'!
testSwiki
	"self debug: #testSwiki"
	| dir morph name |
	self isConnected ifFalse: [^self].
	name _ Time now asSeconds asString.
	dir _ PartsBinDirectory on: self server.
	morph _ Morph new setNameTo: name.
	dir add: morph.
	self assert: (dir morphNamed: name) externalName = name.
	self assert: dir entries first externalName = name.
	self
		assert: (dir entries first form isKindOf: Form)! !


!SuperSwikiFileServer methodsFor: 'for real' stamp: 'tak 1/2/2005 15:12'!
allEntries
	| answer |
	answer := self sendToSwikiProjectServer: {'action: listallfiles'}.
	(answer beginsWith: 'OK')
		ifFalse: [^ #()].
	^ self parseListEntries: answer! !

!SuperSwikiFileServer methodsFor: 'updating' stamp: 'tak 2/20/2005 21:51'!
update: anObject 
	| origin |
	anObject == #configurationChanged
		ifFalse: [^ self].
	origin := SuperSwikiServer allInstances
				detect: [:each | each dependents includes: self]
				ifNone: [^ self].
	self copySameFrom: origin.
	self contentsChanged! !


!SuperSwikiFileServer class methodsFor: 'instance creation' stamp: 'tak 2/20/2005 21:42'!
newFrom: aSuperSwikiFileServer 
	| anInstance |
	anInstance := super newFrom: aSuperSwikiFileServer.
	aSuperSwikiFileServer addDependent: anInstance.
	^ anInstance! !


!TileScriptBuilder methodsFor: 'accessing' stamp: 'tak 12/7/2004 23:44'!
addInstanceVariableNamed: name type: type 
	| itsName initialValue setterSelector |
	itsName _ ScriptingSystem
				acceptableSlotNameFrom: name
				forSlotCurrentlyNamed: nil
				asSlotNameIn: player
				world: morph world.
	itsName isEmpty
		ifTrue: [^ self].
	player slotInfo
		at: itsName
		put: (SlotInformation new initialize type: type).
	initialValue _ player initialValueForSlotOfType: type.
	player addInstanceVarNamed: itsName withValue: initialValue.
	player class compileAccessorsFor: itsName.
	setterSelector _ Utilities setterSelectorFor: itsName.
	(player class allSubInstances copyWithout: player)
		do: [:anInstance | anInstance perform: setterSelector with: initialValue].
	player updateAllViewersAndForceToShow: ScriptingSystem nameForInstanceVariablesCategory! !

!TileScriptBuilder methodsFor: 'accessing' stamp: 'tak 12/7/2004 23:45'!
morph
	^ morph! !

!TileScriptBuilder methodsFor: 'accessing' stamp: 'tak 12/7/2004 20:32'!
morph: aMorph
	morph _ aMorph.
	player _ aMorph assuredPlayer.
	player assureUniClass.
	viewer _ CategoryViewer new initializeFor: player.! !

!TileScriptBuilder methodsFor: 'accessing' stamp: 'tak 12/7/2004 23:52'!
player
	^ player! !

!TileScriptBuilder methodsFor: 'accessing' stamp: 'tak 12/8/2004 10:47'!
script: selector tile: aList 
	| scripter phrase aUniclassScript |
	aUniclassScript _ player class permanentUserScriptFor: selector player: player.
	scripter _ aUniclassScript instantiatedScriptEditorForPlayer: player.
	aList
		do: [:line | 
			phrase _ self buildPhrase: line.
			self addPhrase: phrase at: selector].
	scripter install.
	^ scripter! !

!TileScriptBuilder methodsFor: 'accessing' stamp: 'tak 12/7/2004 23:29'!
selector: selector status: status 
	| aScriptInstantiation |
	aScriptInstantiation _ player scriptInstantiationForSelector: selector.
	aScriptInstantiation status: status! !

!TileScriptBuilder methodsFor: 'building' stamp: 'tak 12/7/2004 20:42'!
addPhrase: phrase at: selector 
	| scripter i |
	scripter _ player scriptEditorFor: selector.
	i _ scripter submorphs size.
	phrase tileRows
		do: [:tileList | 
			scripter
				insertTileRow: (Array
						with: (tileList first rowOfRightTypeFor: scripter forActor: player))
				after: i.
			i _ i + 1]! !

!TileScriptBuilder methodsFor: 'building' stamp: 'tak 12/8/2004 10:07'!
buildCommandPhrase: symbol arg: arg 
	| interface phrase argTile tilePad |
	interface _ Vocabulary eToyVocabulary
				methodInterfaceAt: symbol
				ifAbsent: [self error: 'unresolved symbol ' , symbol].
	phrase _ self phraseForCommandFrom: interface.
	argTile _ arg newTileMorphRepresentative.
	tilePad _ phrase submorphs last.
	tilePad acceptDroppingMorph: argTile event: phrase primaryHand lastEvent.
	^ phrase! !

!TileScriptBuilder methodsFor: 'building' stamp: 'tak 12/8/2004 11:31'!
buildGetterPhrase: symbol 
	| interface getterTiles |
	interface _ Vocabulary eToyVocabulary
				methodInterfaceAt: symbol
				ifAbsent: [self error: 'unresolved symbol ' , symbol].
	getterTiles _ viewer getterTilesFor: symbol type: interface resultType.
	getterTiles justGrabbedFromViewer: false.
	getterTiles firstSubmorph changeTableLayout; hResizing: #shrinkWrap; vResizing: #spaceFill.
	getterTiles changeTableLayout.
	^ getterTiles! !

!TileScriptBuilder methodsFor: 'building' stamp: 'tak 12/8/2004 11:11'!
buildPhrase: line 
	| symbol arg |
	symbol _ line second.
	line size = 2
		ifTrue: [^ self buildGetterPhrase: symbol].
	arg _ line third.
	(symbol size > 3
			and: [(symbol first: 3)
					= 'set'])
		ifTrue: [^ self buildSetterPhrase: symbol arg: arg].
	^ self buildCommandPhrase: symbol arg: arg! !

!TileScriptBuilder methodsFor: 'building' stamp: 'tak 12/8/2004 10:53'!
buildSetterPhrase: symbol arg: arg 
	| interface kernel phrase |
	kernel _ (symbol allButFirst: 3) allButLast withFirstCharacterDownshifted.
	interface _ Vocabulary eToyVocabulary
				methodInterfaceAt: (Utilities getterSelectorFor: kernel)
				ifAbsent: [self error: 'unresolved symbol ' , symbol].
	phrase _ self buildSetterPhrase: interface selector type: interface resultType.
	^ self setPhrase: phrase arg: arg! !

!TileScriptBuilder methodsFor: 'building' stamp: 'tak 12/8/2004 10:45'!
buildSetterPhrase: actualGetter type: argType 
	| m argValue argTile selfTile |
	m := PhraseTileMorph new 
				setAssignmentRoot: (Utilities inherentSelectorForGetter: actualGetter)
				type: #command
				rcvrType: #Player
				argType: argType
				vocabulary: viewer currentVocabulary.
	argValue := viewer scriptedPlayer 
				perform: actualGetter.
	(argValue isKindOf: Player) 
		ifTrue: [argTile := argValue tileReferringToSelf]
		ifFalse: 
			[argTile := ScriptingSystem tileForArgType: argType.
			(argType == #Number and: [argValue isNumber]) 
				ifTrue: 
					[(viewer scriptedPlayer decimalPlacesForGetter: actualGetter) 
						ifNotNilDo: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]].
			argTile
				setLiteral: argValue;
				updateLiteralLabel].
	argTile position: m lastSubmorph position.
	m lastSubmorph addMorph: argTile.
	selfTile := viewer tileForSelf bePossessive.
	selfTile position: m firstSubmorph position.
	m firstSubmorph addMorph: selfTile.
	m enforceTileColorPolicy.
	m justGrabbedFromViewer: false.
	^ m! !

!TileScriptBuilder methodsFor: 'building' stamp: 'tak 12/7/2004 21:38'!
phraseForCommandFrom: aMethodInterface 
	| cmd aPhrase resultType argType argTile selfTile |
	cmd _ aMethodInterface selector.
	resultType _ aMethodInterface resultType.
	cmd numArgs == 0
		ifTrue: [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.
			aPhrase
				setOperator: cmd
				type: resultType
				rcvrType: #Player
				argType: argType.
			argTile _ ScriptingSystem tileForArgType: argType.
			argTile position: aPhrase lastSubmorph position.
			aPhrase lastSubmorph addMorph: argTile].
	selfTile _ viewer tileForSelf.
	selfTile position: aPhrase firstSubmorph position.
	aPhrase firstSubmorph addMorph: selfTile.
	aPhrase justGrabbedFromViewer: false.
	^ aPhrase! !

!TileScriptBuilder methodsFor: 'building' stamp: 'tak 12/8/2004 11:32'!
setPhrase: phrase arg: arg 
	| tilePad tile |
	tile _ arg isCollection
				ifTrue: [self buildPhrase: arg]
				ifFalse: [arg newTileMorphRepresentative].
	tilePad _ phrase submorphs last.
	tilePad acceptDroppingMorph: tile event: phrase primaryHand lastEvent.
	tilePad changeTableLayout.
	(phrase topEditor ifNil: [phrase]) enforceTileColorPolicy.
	^ phrase! !


!TileScriptBuilderTest methodsFor: 'testing' stamp: 'tak 12/7/2004 21:38'!
testCommandPhrase
	"self debug: #testCommandPhrase"
	| b interface phrase |
	b _ TileScriptBuilder new morph: EllipseMorph new.
	interface _ Vocabulary eToyVocabulary
				methodInterfaceAt: #forward:
				ifAbsent: [self error: 'unresolved symbol '].
	phrase _ b phraseForCommandFrom: interface.
	self assert: phrase codeString = '(self forward: (5))'! !

!TileScriptBuilderTest methodsFor: 'testing' stamp: 'tak 12/8/2004 10:44'!
testForward
	"self debug: #testForward"
	| b scripter |
	b _ TileScriptBuilder new morph: EllipseMorph new.
	scripter _ b script: #script1 tile: #((self forward: 10) (self turn: 30)).
	self assert: scripter codeString = '	(self forward: (10))	.
	(self turn: (30))'.! !

!TileScriptBuilderTest methodsFor: 'testing' stamp: 'tak 12/8/2004 11:33'!
testGetSet
	"self debug: #testGetSet"
	| b scripter |
	b _ TileScriptBuilder new morph: EllipseMorph new.
	scripter _ b script: #script1 tile: #((self setX: (self getY))).
	self assert: scripter codeString = '	(self setX:  (self getY))'.

! !

!TileScriptBuilderTest methodsFor: 'testing' stamp: 'tak 12/8/2004 21:09'!
testSet
	"self debug: #testSet"
	| b scripter |
	b _ TileScriptBuilder new morph: EllipseMorph new.
	scripter _ b script: #script1 tile: #((self setX: 200)).
	self assert: scripter codeString = '	(self setX:  (200))'.

! !

!TileScriptBuilderTest methodsFor: 'testing' stamp: 'tak 12/7/2004 23:52'!
testVariable
	"self debug: #testVariable"
	| b |
	b _ TileScriptBuilder new morph: EllipseMorph new.
	b addInstanceVariableNamed: 'friend' type: #Player. 
	self assert: b player getFriend  externalName = 'dot'.
! !

SuperPartsBin initialize!
PartsBinDirectory initialize!