The Trunk: Morphic-nice.274.mcz

Nicolas Cellier uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-nice.274.mcz

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

Name: Morphic-nice.274
Author: nice
Time: 26 December 2009, 7:32:36 am
UUID: b6a23cc6-fe90-4504-b23d-ec562dbacb0c
Ancestors: Morphic-nice.273

Cosmetic changes
1) let #preserveStateDuring: always return the result of evaluating the block argument.
2) suppress a useless block argument assignment.

=============== Diff against Morphic-nice.273 ===============

Item was changed:
  ----- Method: PolygonMorph>>addHandles (in category 'editing') -----
  addHandles
  "Put moving handles at the vertices. Put adding handles at
  edge midpoints.
  Moving over adjacent vertex and dropping will delete a
  vertex. "
+ | tri |
- | handle newVert tri |
  self removeHandles.
  handles := OrderedCollection new.
  tri := Array
  with: 0 @ -4
  with: 4 @ 3
  with: -3 @ 3.
  vertices
  withIndexDo: [:vertPt :vertIndex |
+ | handle |
  handle := EllipseMorph
  newBounds: (Rectangle center: vertPt extent: 8 @ 8)
  color: (self handleColorAt: vertIndex) .
  handle
  on: #mouseMove
  send: #dragVertex:event:fromHandle:
  to: self
  withValue: vertIndex.
  handle
  on: #mouseUp
  send: #dropVertex:event:fromHandle:
  to: self
  withValue: vertIndex.
  handle
  on: #click
  send: #clickVertex:event:fromHandle:
  to: self
  withValue: vertIndex.
  self addMorph: handle.
  handles addLast: handle.
  (closed
  or: [1 = vertices size
  "Give a small polygon a chance to grow.
  -wiz"]
  or: [vertIndex < vertices size])
+ ifTrue: [| newVert |
+ newVert := PolygonMorph
- ifTrue: [newVert := PolygonMorph
  vertices: (tri
  collect: [:p | p + (vertPt
  + (vertices atWrap: vertIndex + 1) // 2)])
  color: Color green
  borderWidth: 1
  borderColor: Color black.
  newVert
  on: #mouseDown
  send: #newVertex:event:fromHandle:
  to: self
  withValue: vertIndex.
  self addMorph: newVert.
  handles addLast: newVert]].
  self isCurvy
  ifTrue: [self updateHandles; layoutChanged].
  self changed!

Item was changed:
  ----- Method: Cubic>>measureFor: (in category 'cubic support') -----
  measureFor: n
  "Return a distance measure for cubic curve with n segments.
  For convienence and accuracy we use the sum of the
  distances. "
  "first point is poly of 0."
  | p1 p2 measure |
  p1 := self first.
  measure := 0.
+ 1 to: n
- (1 to: n)
  do: [:i |
  p2 := self polynomialEval: i / n asFloat.
  measure := measure
  + (p2 dist: p1).
  p1 := p2].
  ^ measure!

Item was changed:
  ----- Method: ColorMappingCanvas>>preserveStateDuring: (in category 'drawing-support') -----
  preserveStateDuring: aBlock
  "Preserve the full canvas state during the execution of aBlock"
+ | oldCanvas result |
- | oldCanvas |
  oldCanvas := myCanvas.
+ result := myCanvas preserveStateDuring:[:newCanvas|
- myCanvas preserveStateDuring:[:newCanvas|
  myCanvas := newCanvas.
  aBlock value: self].
+ myCanvas := oldCanvas.
+ ^result!
- myCanvas := oldCanvas.!

Item was changed:
  ----- Method: DamageRecorder>>recordInvalidRect: (in category 'recording') -----
  recordInvalidRect: newRect
  "Record the given rectangle in my damage list, a list of rectangular areas of the display that should be redraw on the next display cycle."
  "Details: Damaged rectangles are often identical or overlap significantly. In these cases, we merge them to reduce the number of damage rectangles that must be processed when the display is updated. Moreover, above a certain threshold, we ignore the individual rectangles completely, and simply do a complete repaint on the next cycle."
 
+ | mergeRect |
- | mergeRect a |
  totalRepaint ifTrue: [^ self].  "planning full repaint; don't bother collecting damage"
 
  invalidRects do:
  [:rect |
+ | a |
  ((a := (rect intersect: newRect) area) > 40
  and: ["Avoid combining a vertical and horizontal rects.
   Can make a big diff and we only test when likely."
   a > (newRect area // 4) or: [a > (rect area // 4)]])
  ifTrue:
  ["merge rectangle in place (see note below) if there is significant overlap"
  rect setOrigin: (rect origin min: newRect origin) truncated
  corner: (rect corner max: newRect corner) truncated.
  ^ self]].
 
 
  invalidRects size >= 15 ifTrue:
  ["if there are too many separate areas, merge them all"
  mergeRect := Rectangle merging: invalidRects.
  self reset.
  invalidRects addLast: mergeRect].
 
  "add the given rectangle to the damage list"
  "Note: We make a deep copy of all rectangles added to the damage list,
  since rectangles in this list may be extended in place."
  invalidRects addLast:
  (newRect topLeft truncated corner: newRect bottomRight truncated).
  !

Item was changed:
  ----- Method: TextEditor>>inOutdent:delta: (in category 'editing keys') -----
  inOutdent: characterStream delta: delta
  "Add/remove a tab at the front of every line occupied by the selection. Flushes typeahead.  Derived from work by Larry Tesler back in December 1985.  Now triggered by Cmd-L and Cmd-R.  2/29/96 sw"
 
  | cr realStart realStop lines startLine stopLine start stop adjustStart indentation size numLines inStream newString outStream |
  sensor keyboard.  "Flush typeahead"
+ cr := Character cr.
- cr _ Character cr.
 
  "Operate on entire lines, but remember the real selection for re-highlighting later"
+ realStart := self startIndex.
+ realStop := self stopIndex - 1.
- realStart _ self startIndex.
- realStop _ self stopIndex - 1.
 
  "Special case a caret on a line of its own, including weird case at end of paragraph"
  (realStart > realStop and:
  [realStart < 2 or: [(paragraph string at: realStart - 1) == cr]])
  ifTrue:
  [delta < 0
  ifTrue:
  [morph flash]
  ifFalse:
  [self replaceSelectionWith: Character tab asSymbol asText.
  self selectAt: realStart + 1].
  ^true].
 
+ lines := paragraph lines.
+ startLine := paragraph lineIndexOfCharacterIndex: realStart.
+ stopLine := paragraph lineIndexOfCharacterIndex: (realStart max: realStop).
+ start := (lines at: startLine) first.
+ stop := (lines at: stopLine) last.
- lines _ paragraph lines.
- startLine _ paragraph lineIndexOfCharacterIndex: realStart.
- stopLine _ paragraph lineIndexOfCharacterIndex: (realStart max: realStop).
- start _ (lines at: startLine) first.
- stop _ (lines at: stopLine) last.
 
  "Pin the start of highlighting unless the selection starts a line"
+ adjustStart := realStart > start.
- adjustStart _ realStart > start.
 
  "Find the indentation of the least-indented non-blank line; never outdent more"
+ indentation := (startLine to: stopLine) inject: 1000 into:
- indentation _ (startLine to: stopLine) inject: 1000 into:
  [:m :l |
+ m min: (paragraph indentationOfLineIndex: l ifBlank: [:tabs | 1000])].
- m _ m min: (paragraph indentationOfLineIndex: l ifBlank: [:tabs | 1000])].
 
+ size :=  stop + 1 - start.
+ numLines := stopLine + 1 - startLine.
+ inStream := ReadStream on: paragraph string from: start to: stop.
- size _  stop + 1 - start.
- numLines _ stopLine + 1 - startLine.
- inStream _ ReadStream on: paragraph string from: start to: stop.
 
+ newString := String new: size + ((numLines * delta) max: 0).
+ outStream := ReadWriteStream on: newString.
- newString _ String new: size + ((numLines * delta) max: 0).
- outStream _ ReadWriteStream on: newString.
 
  "This subroutine does the actual work"
  self indent: delta fromStream: inStream toStream: outStream.
 
  "Adjust the range that will be highlighted later"
+ adjustStart ifTrue: [realStart := (realStart + delta) max: start].
+ realStop := realStop + outStream position - size.
- adjustStart ifTrue: [realStart _ (realStart + delta) max: start].
- realStop _ realStop + outStream position - size.
 
  "Prepare for another iteration"
+ indentation := indentation + delta.
+ size := outStream position.
+ inStream := outStream setFrom: 1 to: size.
- indentation _ indentation + delta.
- size _ outStream position.
- inStream _ outStream setFrom: 1 to: size.
 
  outStream == nil
  ifTrue: "tried to outdent but some line(s) were already left flush"
  [morph flash]
  ifFalse:
  [self selectInvisiblyFrom: start to: stop.
+ size = newString size ifFalse: [newString := outStream contents].
- size = newString size ifFalse: [newString _ outStream contents].
  self replaceSelectionWith: newString asText].
  self selectFrom: realStart to: realStop. "highlight only the original range"
  ^ true!

Item was changed:
  ----- Method: ColorPatchCanvas>>preserveStateDuring: (in category 'drawing-support') -----
  preserveStateDuring: aBlock
  "Preserve the full canvas state during the execution of aBlock.
  Note: This does *not* include the state in the receiver (e.g., foundMorph)."
+ | tempCanvas result |
- | tempCanvas |
  tempCanvas := self copy.
+ result := aBlock value: tempCanvas.
+ foundMorph := tempCanvas foundMorph.
+ ^result!
- aBlock value: tempCanvas.
- foundMorph := tempCanvas foundMorph.!

Item was changed:
  ----- Method: ComplexProgressIndicator>>backgroundWorldDisplay (in category 'as yet unclassified') -----
  backgroundWorldDisplay
-
- | f |
 
  self flag: #bob. "really need a better way to do this"
 
  "World displayWorldSafely."
 
  "ugliness to try to track down a possible error"
 
 
  [World displayWorld] ifError: [ :a :b |
+ | f |
  stageCompleted := 999.
  f := FileDirectory default fileNamed: 'bob.errors'.
  f nextPutAll: a printString,'  ',b printString; cr; cr.
  f nextPutAll: 'worlds equal ',(formerWorld == World) printString; cr; cr.
  f nextPutAll: thisContext longStack; cr; cr.
  f nextPutAll: formerProcess suspendedContext longStack; cr; cr.
  f close. Beeper beep.
  ].
  !

Item was changed:
  ----- Method: ComplexProgressIndicator class>>historyReport (in category 'as yet unclassified') -----
  historyReport
  "
  ComplexProgressIndicator historyReport
  "
+ | answer |
- | answer data |
  History ifNil: [^Beeper beep].
  answer := String streamContents: [ :strm |
+ | data |
  (History keys asArray sort: [ :a :b | a asString <= b asString]) do: [ :k |
  strm nextPutAll: k printString; cr.
  data := History at: k.
  (data keys asArray sort: [ :a :b | a asString <= b asString]) do: [ :dataKey |
  strm tab; nextPutAll: dataKey printString,'  ',
  (data at: dataKey) asArray printString; cr.
  ].
  strm cr.
  ].
  ].
  StringHolder new
  contents: answer contents;
  openLabel: 'Progress History'!

Item was changed:
  ----- Method: ComplexProgressIndicator>>forkProgressWatcher (in category 'as yet unclassified') -----
  forkProgressWatcher
 
- | killTarget |
  [
+ | killTarget |
  [stageCompleted < 999 and:
  [formerProject == Project current and:
  [formerWorld == World and:
  [translucentMorph world notNil and:
  [formerProcess suspendedContext notNil and:
  [Project uiProcess == formerProcess]]]]]] whileTrue: [
 
  translucentMorph setProperty: #revealTimes toValue:
  {(Time millisecondClockValue - start max: 1). (estimate * newRatio max: 1)}.
  translucentMorph changed.
  translucentMorph owner addMorphInLayer: translucentMorph.
  (Time millisecondClockValue - WorldState lastCycleTime) abs > 500 ifTrue: [
  self backgroundWorldDisplay
  ].
  (Delay forMilliseconds: 100) wait.
  ].
  translucentMorph removeProperty: #revealTimes.
  self loadingHistoryAt: 'total' add: (Time millisecondClockValue - start max: 1).
  killTarget := targetMorph ifNotNil: [
  targetMorph valueOfProperty: #deleteOnProgressCompletion
  ].
  formerWorld == World ifTrue: [
  translucentMorph delete.
  killTarget ifNotNil: [killTarget delete].
  ] ifFalse: [
  translucentMorph privateDeleteWithAbsolutelyNoSideEffects.
  killTarget ifNotNil: [killTarget privateDeleteWithAbsolutelyNoSideEffects].
  ].
  ] forkAt: Processor lowIOPriority.!