The Trunk: EToys-ar.75.mcz

Andreas Raab uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-ar.75.mcz

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

Name: EToys-ar.75
Author: ar
Time: 5 September 2010, 10:55:43.645 am
UUID: edae0055-d73f-e549-bf3b-690b2a8ed951
Ancestors: EToys-eem.74

Restructurings to reduce package depencencies.

=============== Diff against EToys-eem.74 ===============

Item was added:
+ ----- Method: Pen>>arrowHead (in category '*Etoys') -----
+ arrowHead
+ "Put an arrowhead on the previous pen stroke"
+ " | pen | pen := Pen new. 20 timesRepeat: [pen turn: 360//20; go: 20; arrowHead]."
+
+ penDown ifTrue:
+ [self arrowHeadFrom: (direction degreeCos @ direction degreeSin) * -40 + location
+ to: location
+ arrowSpec: (Preferences parameterAt: #arrowSpec ifAbsent: [5 @ 4])]!

Item was added:
+ ----- Method: Pen>>arrowHeadFrom:to:forPlayer: (in category '*Etoys') -----
+ arrowHeadFrom: prevPt to: newPt forPlayer: aPlayer
+ "Put an arrowhead on the pen stroke from oldPt to newPt"
+
+ | aSpec |
+ (aPlayer notNil and: [(aSpec := aPlayer costume renderedMorph valueOfProperty: #arrowSpec) notNil])
+ ifFalse:
+ [aSpec := Preferences parameterAt: #arrowSpec "may well be nil"].
+ self arrowHeadFrom: prevPt to: newPt arrowSpec: aSpec!

Item was added:
+ ----- Method: FileDirectory>>hasEToyUserList (in category '*Etoys') -----
+ hasEToyUserList
+ ^self eToyUserListUrl notNil or:[self eToyBaseFolderSpec notNil]!

Item was added:
+ ----- Method: FileDirectory>>eToyBaseFolderSpec (in category '*Etoys') -----
+ eToyBaseFolderSpec
+ ^ServerDirectory eToyBaseFolderSpecForFileDirectory: self!

Item was added:
+ ----- Method: FileDirectory>>eToyUserListUrl: (in category '*Etoys') -----
+ eToyUserListUrl: urlString
+ ^ServerDirectory eToyUserListUrlForFileDirectory: self put: urlString.!

Item was added:
+ ----- Method: FileDirectory>>eToyBaseFolderSpec: (in category '*Etoys') -----
+ eToyBaseFolderSpec: aString
+ ^ServerDirectory eToyBaseFolderSpecForFileDirectory: self put: aString!

Item was added:
+ ----- Method: Pen>>arrowHeadFrom:to:arrowSpec: (in category '*Etoys') -----
+ arrowHeadFrom: prevPt to: newPt arrowSpec: anArrowSpec
+ "Put an arrowhead on the pen stroke from oldPt to newPt"
+
+ | pm af myColor finalPt delta |
+ myColor := self color.
+ delta := newPt - prevPt.
+ delta r <= 2 "pixels" ifTrue: [^ self].
+ finalPt := newPt + (Point r: sourceForm width degrees: delta degrees). "in same direction"
+ pm := PolygonMorph vertices: (Array with: prevPt asIntegerPoint with: finalPt asIntegerPoint)  
+ color: myColor  "not used"
+ borderWidth: sourceForm width borderColor: myColor.
+ pm makeOpen; makeForwardArrow.
+ anArrowSpec ifNotNil: [pm arrowSpec: anArrowSpec].
+ af := pm arrowForms first.
+ "render it onto the destForm"
+ (FormCanvas on: destForm "Display") stencil: af at: af offset + (1@1)
+ color: myColor!

Item was added:
+ ----- Method: FileDirectory>>eToyUserName: (in category '*Etoys') -----
+ eToyUserName: aString
+ "Set the default directory from the given user name"
+ | dirName |
+ dirName := self eToyBaseFolderSpec. "something like 'U:\Squeak\users\*-Squeak'"
+ dirName ifNil:[^self].
+ dirName := dirName copyReplaceAll:'*' with: aString.
+ " dirName last = self class pathNameDelimiter ifFalse:[dirName := dirName, self slash].
+ FileDirectory setDefaultDirectoryFrom: dirName.
+ dirName := dirName copyFrom: 1 to: dirName size - 1.
+
+ " pathName := FilePath pathName: dirName!

Item was added:
+ ----- Method: FileDirectory>>eToyUserList (in category '*Etoys') -----
+ eToyUserList
+ | spec index fd list match |
+ spec := self eToyBaseFolderSpec. "something like 'U:\Squeak\users\*-Squeak'."
+ spec ifNil:[^ServerDirectory eToyUserListForFileDirectory: self].
+ "Compute list of users based on base folder spec"
+ index := spec indexOf: $*. "we really need one"
+ index = 0 ifTrue:[^ServerDirectory eToyUserListForFileDirectory: self].
+ fd := FileDirectory on: (FileDirectory dirPathFor: (spec copyFrom: 1 to: index)).
+ "reject all non-directories"
+ list := fd entries select:[:each| each isDirectory].
+ "reject all non-matching entries"
+ match := spec copyFrom: fd pathName size + 2 to: spec size.
+ list := list collect:[:each| each name].
+ list := list select:[:each| match match: each].
+ "extract the names (e.g., those positions that match '*')"
+ index := match indexOf: $*.
+ list := list collect:[:each|
+ each copyFrom: index to: each size - (match size - index)].
+ ^list!

Item was added:
+ ----- Method: Pen>>arrowHeadForArrowSpec: (in category '*Etoys') -----
+ arrowHeadForArrowSpec: anArrowSpec
+ "Put an arrowhead on the previous pen stroke"
+ "
+ | pen aPoint |
+ aPoint := Point fromUser.
+ pen := Pen new.
+ 20 timesRepeat: [pen turn: 360//20; go: 20; arrowHeadForArrowSpec: aPoint].
+ "
+
+
+ penDown ifTrue:
+ [self arrowHeadFrom: (direction degreeCos @ direction degreeSin) * -40 + location
+ to: location
+ arrowSpec: anArrowSpec]!

Item was added:
+ ----- Method: FileDirectory>>eToyUserListUrl (in category '*Etoys') -----
+ eToyUserListUrl
+ ^ServerDirectory eToyUserListUrlForFileDirectory: self!