[squeak-dev] The Trunk: MorphicExtras-nice.63.mczcommits at source.squeak.org commits at source.squeak.orgSat Dec 26 22:24:03 UTC 2009
Nicolas Cellier uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-nice.63.mcz ==================== Summary ==================== Name: MorphicExtras-nice.63 Author: nice Time: 26 December 2009, 11:23:15 am UUID: 0e933dab-d4cf-4f19-8102-6a8f95283c9b Ancestors: MorphicExtras-ar.62 Cosmetic: puch a few temps inside closures =============== Diff against MorphicExtras-ar.62 =============== Item was changed: ----- Method: PartsBin>>listDirection:quadList:buttonClass: (in category 'initialization') ----- listDirection: aListDirection quadList: quadList buttonClass: buttonClass "Initialize the receiver to run horizontally or vertically, obtaining its elements from the list of tuples of the form: (<receiver> <selector> <label> <balloonHelp>) Used by external package Connectors." - | aButton aClass | self layoutPolicy: TableLayout new. self listDirection: aListDirection. self wrapCentering: #topLeft. self layoutInset: 2. self cellPositioning: #bottomCenter. 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 | + | aButton aClass | aClass := Smalltalk at: tuple first. aButton := buttonClass 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]. self addMorphBack: aButton]! Item was changed: ----- Method: WaveEditor>>chooseLoopStart (in category 'menu') ----- chooseLoopStart + | bestLoops choice start labels values | - | bestLoops secs choice start labels values | possibleLoopStarts ifNil: [ Utilities informUser: 'Finding possible loop points...' translated during: [possibleLoopStarts := self findPossibleLoopStartsFrom: graph cursor]]. bestLoops := possibleLoopStarts copyFrom: 1 to: (100 min: possibleLoopStarts size). labels := OrderedCollection new. values := OrderedCollection new. bestLoops do: [:entry | + | secs | secs := ((loopEnd - entry first) asFloat / self samplingRate) roundTo: 0.01. labels add: ('{1} cycles; {2} secs' translated format:{entry third. secs}). values add: entry]. choice := UIManager default chooseFrom: labels values: values. choice ifNil: [^ self]. loopCycles := choice third. start := self fractionalLoopStartAt: choice first. self loopLength: (loopEnd asFloat - start) + 1.0. ! Item was changed: ----- Method: PartsBin class>>thumbnailForInstanceOf: (in category 'thumbnail cache') ----- thumbnailForInstanceOf: aMorphClass "Answer a thumbnail for a stand-alone instance of the given class, creating it if necessary. If it is created afresh, it will also be cached at this time" - | aThumbnail | ^ Thumbnails at: aMorphClass name ifAbsent: + [| aThumbnail | + aThumbnail := Thumbnail new makeThumbnailFromForm: aMorphClass newStandAlone imageForm. - [aThumbnail := Thumbnail new makeThumbnailFromForm: aMorphClass newStandAlone imageForm. self cacheThumbnail: aThumbnail forSymbol: aMorphClass name. ^ aThumbnail] "PartsBin initialize"! Item was changed: ----- Method: PostscriptEncoder class>>mapMacStringToPS: (in category 'configuring') ----- mapMacStringToPS: aString + | copy | - | copy val newVal | MacToPSCharacterMappings ifNil: [ MacToPSCharacterMappings := Array new: 256. self macToPSCharacterChart do: [ :pair | pair second = 999 ifFalse: [MacToPSCharacterMappings at: pair first put: pair second] ]. ]. copy := aString copy. copy withIndexDo: [ :ch :index | + | val | (val := ch asciiValue) > 127 ifTrue: [ + | newVal | (newVal := MacToPSCharacterMappings at: val) ifNotNil: [ copy at: index put: newVal asCharacter ]. ]. ]. ^copy! Item was changed: ----- Method: SoundLoopMorph>>buildSound (in category 'as yet unclassified') ----- buildSound "Build a compound sound for the next iteration of the loop." + | mixer soundMorphs | - | mixer soundMorphs startTime pan | mixer := MixedSound new. mixer add: (RestSound dur: (self width - (2 * borderWidth)) / 128.0). soundMorphs := self submorphs select: [:m | m respondsTo: #sound]. soundMorphs do: [:m | + | startTime pan | startTime := (m position x - (self left + borderWidth)) / 128.0. pan := (m position y - (self top + borderWidth)) asFloat / (self height - (2 * borderWidth) - m height). mixer add: ((RestSound dur: startTime), m sound copy) pan: pan]. ^ mixer ! Item was changed: ----- Method: FunctionComponent>>headerString (in category 'as yet unclassified') ----- headerString - | ps | ^ String streamContents: + [:s | + | ps | + s nextPutAll: self knownName. - [: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 changed: ----- Method: DSCPostscriptCanvasToDisk class>>morphAsPostscript:rotated:offsetBy:specs: (in category 'as yet unclassified') ----- morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset specs: specsOrNil - | newFileName stream | ^[ (self new morphAsPostscript: aMorph rotated: rotateFlag offsetBy: offset) close ] on: PickAFileToWriteNotification do: [ :ex | + | newFileName stream | newFileName := UIManager default request: 'Name of file to write:' translated initialAnswer: 'xxx',Time millisecondClockValue printString, self defaultExtension. newFileName isEmptyOrNil ifFalse: [ stream := FileStream fileNamed: newFileName. stream ifNotNil: [ex resume: stream]. ]. ]. ! Item was changed: ----- Method: ObjectsTool>>showCategory:fromButton: (in category 'categories') ----- showCategory: aCategoryName fromButton: aButton "Project items from the given category into my lower pane" + - | quads | "self partsBin removeAllMorphs. IMHO is redundant, " - Cursor wait + showWhile: [ + | quads | + quads := OrderedCollection new. - showWhile: [quads := OrderedCollection new. Morph withAllSubclasses do: [:aClass | aClass theNonMetaClass addPartsDescriptorQuadsTo: quads if: [:aDescription | aDescription translatedCategories includes: aCategoryName]]. quads := quads asSortedCollection: [:q1 :q2 | q1 third <= q2 third]. self installQuads: quads fromButton: aButton]! Item was changed: ----- Method: PostscriptCanvas>>preserveStateDuring: (in category 'drawing-support') ----- preserveStateDuring: aBlock + ^target preserveStateDuring: [ :innerTarget | + | retval saveClip saveTransform | - | retval saveClip saveTransform | - target preserveStateDuring: [ :innerTarget | saveClip := clipRect. saveTransform := currentTransformation. gstateStack addLast: currentFont. gstateStack addLast: currentColor. gstateStack addLast: shadowColor. retval := aBlock value: self. shadowColor := gstateStack removeLast. currentColor := gstateStack removeLast. currentFont := gstateStack removeLast. clipRect := saveClip. currentTransformation := saveTransform. + retval + ].! - ]. - ^ retval - ! Item was changed: ----- Method: PostscriptCanvas>>transformBy:clippingTo:during:smoothing: (in category 'drawing-support') ----- transformBy: aDisplayTransform clippingTo: aClipRect during: aBlock smoothing: cellSize | retval oldShadow | oldShadow := shadowColor. self comment: 'drawing clipped ' with: aClipRect. self comment: 'drawing transformed ' with: aDisplayTransform. + retval := self - self preserveStateDuring: [:inner | currentTransformation ifNil: [currentTransformation := aDisplayTransform] ifNotNil: [currentTransformation := currentTransformation composedWithLocal: aDisplayTransform]. aClipRect ifNotNil: [clipRect := aDisplayTransform globalBoundsToLocal: (clipRect intersect: aClipRect). inner rect: aClipRect; clip]. inner transformBy: aDisplayTransform. + aBlock value: inner]. - retval := aBlock value: inner]. self comment: 'end of drawing clipped ' with: aClipRect. shadowColor := oldShadow. ^ retval! Item was changed: ----- Method: ObjectsTool>>alphabeticTabs (in category 'alphabetic') ----- alphabeticTabs "Answer a list of buttons which, when hit, will trigger the choice of a morphic category" + | buttonList tabLabels | - | buttonList aButton tabLabels | self flag: #todo. "includes non-english characters" tabLabels := (($a to: $z) collect: [:ch | ch asString]) asOrderedCollection. buttonList := tabLabels collect: [:catName | + | aButton | aButton := SimpleButtonMorph new label: catName. aButton actWhen: #buttonDown. aButton target: self; actionSelector: #showAlphabeticCategory:fromButton:; arguments: {catName. aButton}]. ^ buttonList "ObjectsTool new tabsForMorphicCategories"! Item was changed: ----- Method: Command>>veryDeepFixupWith: (in category 'copying') ----- veryDeepFixupWith: deepCopier - | old | "ALL inst vars were weakly copied. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!" + super veryDeepFixupWith: deepCopier. + 1 to: self class instSize do: + [:ii | + | old | + old := self instVarAt: ii. + self instVarAt: ii put: (deepCopier references at: old ifAbsent: [old])].! - - super veryDeepFixupWith: deepCopier. - 1 to: self class instSize do: - [:ii | old := self instVarAt: ii. - self instVarAt: ii put: (deepCopier references at: old ifAbsent: [old])]. - - ! Item was changed: ----- Method: SketchEditorMorph>>fill: (in category 'actions & preps') ----- fill: evt "Find the area that is the same color as where you clicked. Fill it with the current paint color." - | box | evt isMouseUp ifFalse: [^ self]. "Only fill upon mouseUp" "would like to only invalidate the area changed, but can't find out what it is." Cursor execute showWhile: [ + | box | box := paintingForm floodFill: (self getColorFor: evt) at: evt cursorPoint - bounds origin. self render: (box translateBy: bounds origin)]! Item was changed: ----- Method: PostscriptCanvas>>definePathProcIn:during: (in category 'drawing-support') ----- definePathProcIn: pathBlock during: duringBlock "Bracket the output of pathBlock (which is passed the receiver) in gsave newpath <pathBlock> closepath <duringBlock> grestore " + ^self - | retval | - self preserveStateDuring: [:tgt | + | retval | self comment: 'begin pathProc path block'. target newpath. pathBlock value: tgt. target closepath. self comment: 'begin pathProc during block'. retval := duringBlock value: tgt. + self comment: 'end pathProc'. + retval].! - self comment: 'end pathProc']. - ^ retval! Item was changed: ----- Method: Command class>>undoRedoButtons (in category 'dog simple ui') ----- undoRedoButtons "Answer a morph that offers undo and redo buttons" + | wrapper | - | aButton wrapper | "self currentHand attachMorph: Command undoRedoButtons" wrapper := AlignmentMorph newColumn. wrapper color: Color veryVeryLightGray lighter; borderWidth: 0; layoutInset: 0; vResizing: #shrinkWrap; hResizing: #shrinkWrap. #((CrudeUndo undoLastCommand 'undo last command done' undoEnabled CrudeUndoDisabled CrudeUndoDisabled) (CrudeRedo redoNextCommand 'redo last undone command' redoEnabled CrudeRedoDisabled CrudeRedoDisabled)) do: [:tuple | + | aButton | wrapper addTransparentSpacerOfSize: (8 at 0). aButton := UpdatingThreePhaseButtonMorph new. aButton onImage: (ScriptingSystem formAtKey: tuple first); offImage: (ScriptingSystem formAtKey: tuple fifth); pressedImage: (ScriptingSystem formAtKey: tuple sixth); getSelector: tuple fourth; color: Color transparent; target: self; actionSelector: tuple second; setNameTo: tuple second; setBalloonText: tuple third; extent: aButton onImage extent. wrapper addMorphBack: aButton. wrapper addTransparentSpacerOfSize: (8 at 0)]. ^ wrapper! Item was changed: ----- Method: StringMorph>>handsWithMeForKeyboardFocus (in category '*MorphicExtras-accessing') ----- handsWithMeForKeyboardFocus - | foc | "Answer the hands that have me as their keyboard focus" hasFocus ifFalse: [^ #()]. ^ self currentWorld hands select: + [:aHand | + | foc | + (foc := aHand keyboardFocus) notNil and: [foc owner == self]]! - [:aHand | (foc := aHand keyboardFocus) notNil and: [foc owner == self]]! Item was changed: ----- Method: FatBitsPaint>>fill (in category 'menu') ----- fill | fillPt | Cursor blank show. + fillPt := Cursor crossHair showWhile: + [Sensor waitButton - self position]. - Cursor crossHair showWhile: - [fillPt := Sensor waitButton - self position]. originalForm shapeFill: brushColor interiorPoint: fillPt. self changed. ! Item was changed: ----- Method: ZoomAndScrollControllerMorph>>targetScriptDictionary (in category 'as yet unclassified') ----- targetScriptDictionary - | scriptDict | target ifNil: [^Dictionary new]. ^target valueOfProperty: #namedCameraScripts ifAbsent: [ + | scriptDict | scriptDict := Dictionary new. target setProperty: #namedCameraScripts toValue: scriptDict. scriptDict ]. ! Item was changed: ----- Method: ObjectsTool>>modeTabs (in category 'major modes') ----- modeTabs "Answer a list of buttons which, when hit, will trigger the choice of mode of the receiver" + | buttonList tupleList | - | buttonList aButton tupleList | tupleList := #( ('alphabetic' alphabetic showAlphabeticTabs 'A separate tab for each letter of the alphabet') ('find' search showSearchPane 'Provides a type-in pane allowing you to match') ('categories' categories showCategories 'Grouped by category') "('standard' standard showStandardPane 'Standard Squeak tools supplies for building')" ). buttonList := tupleList collect: [:tuple | + | aButton | aButton := SimpleButtonMorph new label: tuple first translated. aButton actWhen: #buttonUp. aButton setProperty: #modeSymbol toValue: tuple second. aButton target: self; actionSelector: tuple third. aButton setBalloonText: tuple fourth translated. aButton borderWidth: 0. aButton]. ^ buttonList "ObjectsTool new modeTabs"! Item was changed: ----- Method: Flaps class>>addIndividualGlobalFlapItemsTo: (in category 'menu support') ----- addIndividualGlobalFlapItemsTo: aMenu "Add items governing the enablement of specific global flaps to aMenu" - | anItem | self globalFlapTabsIfAny do: [:aFlapTab | + | anItem | + anItem := aMenu addUpdating: #globalFlapWithIDEnabledString: enablementSelector: #showSharedFlaps target: self selector: #enableDisableGlobalFlapWithID: argumentList: {aFlapTab flapID}. - anItem _ aMenu addUpdating: #globalFlapWithIDEnabledString: enablementSelector: #showSharedFlaps target: self selector: #enableDisableGlobalFlapWithID: argumentList: {aFlapTab flapID}. anItem wordingArgument: aFlapTab flapID. anItem setBalloonText: aFlapTab balloonTextForFlapsMenu].! Item was changed: ----- Method: FunctionComponent>>getText (in category 'model access') ----- getText - | ps | ^ ('"type a function of' , (String streamContents: + [:s | + | ps | + 2 to: pinSpecs size do: - [: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 changed: ----- Method: ObjectsTool>>tabsForCategories (in category 'categories') ----- tabsForCategories "Answer a list of buttons which, when hit, will trigger the choice of a category" + | buttonList classes categoryList basic | - | buttonList aButton classes categoryList basic | classes := Morph withAllSubclasses. categoryList := Set new. classes do: [:aClass | (aClass class includesSelector: #descriptionForPartsBin) ifTrue: [categoryList addAll: aClass descriptionForPartsBin translatedCategories]. (aClass class includesSelector: #supplementaryPartsDescriptions) ifTrue: [aClass supplementaryPartsDescriptions do: [:aDescription | categoryList addAll: aDescription translatedCategories]]]. categoryList := OrderedCollection withAll: (categoryList asSortedArray). basic := categoryList remove: ' Basic' translated ifAbsent: [ ]. basic ifNotNil: [ categoryList addFirst: basic ]. basic := categoryList remove: 'Basic' translated ifAbsent: [ ]. basic ifNotNil: [ categoryList addFirst: basic ]. buttonList := categoryList collect: [:catName | + | aButton | aButton := SimpleButtonMorph new label: catName. aButton actWhen: #buttonDown. aButton target: self; actionSelector: #showCategory:fromButton:; arguments: {catName. aButton}]. ^ buttonList "ObjectsTool new tabsForCategories"! Item was changed: ----- Method: ObjectsTool>>showAlphabeticCategory:fromButton: (in category 'submorph access') ----- showAlphabeticCategory: aString fromButton: aButton "Blast items beginning with a given letter into my lower pane" - | eligibleClasses quads uc | self partsBin removeAllMorphs. - uc := aString asUppercase asCharacter. Cursor wait + showWhile: [ + | eligibleClasses quads uc | + uc := aString asUppercase asCharacter. + eligibleClasses := Morph withAllSubclasses. - showWhile: [eligibleClasses := Morph withAllSubclasses. quads := OrderedCollection new. eligibleClasses do: [:aClass | aClass theNonMetaClass addPartsDescriptorQuadsTo: quads if: [:info | info formalName translated asUppercase first = uc]]. self installQuads: quads fromButton: aButton]! Item was changed: ----- Method: ObjectsTool>>showMorphsMatchingSearchString (in category 'search') ----- showMorphsMatchingSearchString "Put items matching the search string into my lower pane" - | quads | self setSearchStringFromSearchPane. self partsBin removeAllMorphs. Cursor wait + showWhile: [ + | quads | + quads := OrderedCollection new. - showWhile: [quads := OrderedCollection new. Morph withAllSubclasses do: [:aClass | aClass addPartsDescriptorQuadsTo: quads if: [:info | info formalName translated includesSubstring: searchString caseSensitive: false]]. self installQuads: quads fromButton: nil]! Item was changed: ----- Method: PartsBin class>>thumbnailForPartsDescription: (in category 'thumbnail cache') ----- thumbnailForPartsDescription: aPartsDescription "Answer a thumbnail for the given parts description creating it if necessary. If it is created afresh, it will also be cached at this time" + | aSymbol | - | aThumbnail aSymbol | aSymbol := aPartsDescription formalName asSymbol. ^ Thumbnails at: aSymbol ifAbsent: + [| aThumbnail | + aThumbnail := Thumbnail new makeThumbnailFromForm: aPartsDescription sampleImageForm. - [aThumbnail := Thumbnail new makeThumbnailFromForm: aPartsDescription sampleImageForm. self cacheThumbnail: aThumbnail forSymbol: aSymbol. ^ aThumbnail] "PartsBin initialize"! Item was changed: ----- Method: BouncingAtomsMorph>>addAtoms: (in category 'other') ----- addAtoms: n "Add a bunch of new atoms." - | a | n timesRepeat: [ + | a | a := AtomMorph new. a randomPositionIn: bounds maxVelocity: 10. self addMorph: a]. self stopStepping. !
More information about the Squeak-dev mailing list |