The Trunk: MorphicExtras-nice.63.mcz

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@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@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.
  !