The Trunk: Morphic-nice.275.mcz

> Nicolas Cellier uploaded a new version of Morphic to project The Trunk:
> http://source.squeak.org/trunk/Morphic-nice.275.mcz
>
> ==================== Summary ====================
>
> Name: Morphic-nice.275
> Author: nice
> Time: 27 December 2009, 12:02:10 pm
> UUID: cc9ec099-bcc1-4649-8ff7-6f0aee2051a3
> Ancestors: Morphic-nice.274
>
> #assertSlopesWith:from:to: did return self
> I did not dare removing it though http://bugs.squeak.org/view.php?id=6698 recommandations
>
> =============== Diff against Morphic-nice.274 ===============
>
> Item was changed:
>  ----- Method: WorldState>>selectHandsToDrawForDamage: (in category 'hands') -----
>  selectHandsToDrawForDamage: damageList
>        "Select the set of hands that must be redrawn because either (a) the hand itself has changed or (b) the hand intersects some damage rectangle."
>
> +       | result |
> -       | result hBnds |
>        result := OrderedCollection new.
>        hands do: [:h |
>                h needsToBeDrawn ifTrue: [
>                        h hasChanged
>                                ifTrue: [result add: h]
>                                ifFalse: [
> +                                       | hBnds |
>                                        hBnds := h fullBounds.
>                                        (damageList detect: [:r | r intersects: hBnds] ifNone: [nil])
>                                                ifNotNil: [result add: h]]]].
>        ^ result
>  !
>
> Item was changed:
>  ----- Method: TextEditor>>undoAgain:andReselect:typedKey: (in category 'undoers') -----
>  undoAgain: indices andReselect: home typedKey: wasTypedKey
>        "The last command was again.  Undo it. Redoer: itself."
>
> +       | findSize substText |
> -       | findSize substText index subject |
>        (self isRedoing & wasTypedKey) ifTrue: "redelete search key"
>                [self selectInterval: home.
>                self zapSelectionWith: self nullText].
>
> +       findSize := (self isRedoing ifTrue: [FindText] ifFalse: [ChangeText]) size.
> +       substText := self isUndoing ifTrue: [FindText] ifFalse: [ChangeText].
> -       findSize _ (self isRedoing ifTrue: [FindText] ifFalse: [ChangeText]) size.
> -       substText _ self isUndoing ifTrue: [FindText] ifFalse: [ChangeText].
>        (self isUndoing ifTrue: [indices size to: 1 by: -1] ifFalse: [1 to: indices size]) do:
>                [:i |
> +               | index subject |
> +               index := indices at: i.
> +               (subject := index to: index + findSize - 1) = self selectionInterval ifFalse:
> -               index _ indices at: i.
> -               (subject _ index to: index + findSize - 1) = self selectionInterval ifFalse:
>                        [self selectInterval: subject].
>                FindText == ChangeText ifFalse: [self zapSelectionWith: substText]].
>
>        self isUndoing
>                ifTrue:  "restore selection to where it was when 'again' was invoked"
>                        [wasTypedKey
>                                ifTrue: "search started by typing key at a caret; restore it"
>                                        [self selectAt: home first.
>                                        self zapSelectionWith: FindText.
>                                        self selectAt: home last + 1]
>                                ifFalse: [self selectInterval: home]].
>
>        self undoMessage: UndoMessage forRedo: self isUndoing!
>
> Item was changed:
>  ----- Method: SequenceableCollection>>closedCubicSlopes (in category '*Morphic-NewCurves-cubic support') -----
>  closedCubicSlopes
>        "Sent to knots returns the slopes of a closed cubic spline.
>        From the same set of java sources as naturalCubic. This is a squeak
>        transliteration of the java code."
>        "from java code NatCubicClosed extends NatCubic
>        solves for the set of equations for all knots:
>        b1+4*b2+b3=3*(a3-a1)
>        where a1 is (knots atWrap: index + 1) etc.
>        and the b's are the slopes .
>
>        by decomposing the matrix into upper triangular and lower matrices
>        and then back sustitution. See Spath 'Spline Algorithms for Curves
>        and Surfaces' pp 19--21. The D[i] are the derivatives at the knots.
>        "
>
>        | v w x y z n1  D F G H |
>        n1 := self size.
>        n1 < 3
>                ifTrue: [self error: 'Less than 3 points makes a poor curve'].
>        v := Array new: n1.
>        w := Array new: n1.
>        y := Array new: n1.
>
>        D := Array new: n1.
>        x := self.
>        z := 1.0 / 4.0.
>        v at: 2 put: z.
>        w at: 2 put: z.
>        y at: 1 put: z * 3.0 * ((x at: 2)
>                                - (x at: n1)).
>        H := 4.0.
>        F := 3 * ((x at: 1)
>                                        - (x at: n1 - 1)).
>        G := 1.
> +       2 to: n1 - 1
> -       (2 to: n1 - 1)
>                do: [:k |
>                        z := 1.0 / (4.0
>                                                        - (v at: k)).
>                        v at: k + 1 put: z.
>                        w at: k + 1 put: z negated
>                                        * (w at: k).
>                        y at: k put: z * (3.0 * ((x at: k + 1)
>                                                        - (x at: k - 1))
>                                                - (y at: k - 1)).
>                        H := H - (G
>                                                * (w at: k)).
>                        F := F - (G
>                                                * (y at: k - 1)).
>                        G := (v at: k) negated * G].
>        H := H - (G + 1 * ((v at: n1)
>                                                + (w at: n1))).
>        y at: n1 put: F - (G + 1
>                                * (y at: n1 - 1)).
>        D at: n1 put: (y at: n1)
>                        / H.
>        D at: n1 - 1 put: (y at: n1 - 1)
>                        - ((v at: n1)
>                                        + (w at: n1)
>                                        * (D at: n1)).
>        (1 to: n1 - 2)
>                reverseDo: [:k | D at: k put: (y at: k)
>                                        - ((v at: k + 1)
>                                                        * (D at: k + 1)) - ((w at: k + 1)
>                                                * (D at: n1))].
> +       ^ D .!
> - ^ D .
> -
> - !
>
> Item was changed:
>  ----- Method: SmalltalkEditor>>changeEmphasis: (in category 'editing keys') -----
>  changeEmphasis: characterStream
>        "Change emphasis without styling if necessary"
> +       styler ifNil: [^super changeEmphasis: characterStream].
> +       ^styler evaluateWithoutStyling: [super changeEmphasis: characterStream].!
> -       | result |
> -       styler ifNil:[^super changeEmphasis: characterStream].
> -       styler evaluateWithoutStyling: [result := super changeEmphasis: characterStream].
> -       ^result!
>
> Item was changed:
>  ----- Method: SequenceableCollection>>nilTransitions (in category '*Morphic-NewCurves-cubic support') -----
>  nilTransitions
>        "Return an OrderedCollection of transition indexes.
>        Indexes represent where the list elements transitions
>        from nil to nonNil
>                or from nonNil to nil.
>        1 is an index in the list iff the first element is nonNil. "
>
>        | changes nilSkip |
>
>        changes := OrderedCollection new.
>        nilSkip := true .
>
> +       1 to: self size
> -       (1 to: self size)
>                do: [:i | (self atWrap: i) isNil == nilSkip
>                                ifFalse: [changes add: i.
>                                        nilSkip := nilSkip not]].
>
>        ^ changes !
>
> Item was changed:
>  ----- Method: WorldState>>stepListSortBlock (in category 'initialization') -----
>  stepListSortBlock
> -
> -       | answer |
> -
>        "Please pardon the hackery below. Since the block provided by this method is retained elsewhere, it is possible that the block argument variables would retain references to objects that were no longer really needed. In one case, this feature resulted in doubling the size of a published project."
>
>        ^[ :stepMsg1 :stepMsg2 |
> +               | answer |
>                answer := stepMsg1 scheduledTime <= stepMsg2 scheduledTime.
>                stepMsg1 := stepMsg2 := nil.
>                answer
>        ]!
>
> Item was changed:
>  ----- Method: SequenceableCollection>>assertSlopesWith:from:to: (in category '*Morphic-NewCurves-cubic support') -----
>  assertSlopesWith: knots from: start to: end
>     "
>        We trust everything has been checked.
>        The following assertions should hold at this point: "
>
> -
> -       | slope |
>        self assert: [ self size = knots size ] .
>        "Sizes must be consistent."
>        self assert: [ end > start].
>        "There must be at least one slope to clamp."
>        self assert: [ 0 < start and: [start <= knots size] ].
>        "The clamped slope may be the last one."
>        self assert: [  end  <= knots size + start ] .
>        "We can wrap. There may be only one known slope."
>        "xxx self assert: [ end = knots size + start ifTrue: [ (self at: start) notNil ] ] . xxx"
>                "xxx If we overlap slope must be known. xxx"
>        { start . end }
> +               do: [ :index |
> +                       | slope |
> +                       slope := (self at: index ).
> +                       self assert: [ slope isNil
> -               do: [ :index | slope := (self at: index )
> -       self assert: [ slope isNil
>                                or: [ slope isNumber
>                                or: [ slope isPoint ] ] ] ] .
>        "And a known and reasonalble value or nil."
> +       ^true
> -               ^true
>        !
>
> Item was changed:
>  ----- Method: SketchMorph>>canBeEnlargedWithB3D (in category 'drawing') -----
>  canBeEnlargedWithB3D
> -
> -       | answer |
> -
>        ^self
>                valueOfProperty: #canBeEnlargedWithB3D
>                ifAbsent: [
> +                       | answer |
>                        answer := self rotatedForm colorsUsed allSatisfy: [ :c | c isTranslucent not].
>                        self setProperty: #canBeEnlargedWithB3D toValue: answer.
>                        answer
>                ]!
>
> Item was changed:
>  ----- Method: StandardScriptingSystem>>deletePrivateGraphics:afterStoringToFileNamed: (in category 'form dictionary') -----
>  deletePrivateGraphics: nameList afterStoringToFileNamed: aFileName
>        "This method is used to strip private graphics from the FormDictionary and store them on a file of the given name"
>
> +       | replacement toRemove aReferenceStream |
> -       |  replacement toRemove aReferenceStream keySymbol |
>        toRemove := Dictionary new.
>        replacement := FormDictionary at: #Gets.
>
>        nameList do:
>                [:aKey |
> +                       | keySymbol |
>                        keySymbol := aKey asSymbol.
>                        (toRemove at: keySymbol put: (self formAtKey: keySymbol)).
>                        FormDictionary at: keySymbol put: replacement].
>
>        aReferenceStream := ReferenceStream fileNamed: aFileName.
>        aReferenceStream nextPut: toRemove.
>        aReferenceStream close!
>
> Item was changed:
>  ----- Method: TextEditor>>explainClass: (in category 'explain') -----
>  explainClass: symbol
>        "Is symbol a class variable or a pool variable?"
>        | class reply classes |
>        (model respondsTo: #selectedClassOrMetaClass)
>                ifFalse: [^ nil].
>        (class := model selectedClassOrMetaClass) ifNil: [^ nil].
>        "no class is selected"
>        (class isKindOf: Metaclass)
>                ifTrue: [class := class soleInstance].
> +       classes := class withAllSuperclasses.
> -       classes := (Array with: class)
> -                               , class allSuperclasses.
>        "class variables"
> +       reply := classes detect: [:each | each classVarNames anySatisfy: [:name | symbol = name]]
> -       reply := classes detect: [:each | (each classVarNames detect: [:name | symbol = name]
> -                                       ifNone: [])
> -                                       ~~ nil]
>                                ifNone: [].
>        reply == nil ifFalse: [^ '"is a class variable, defined in class ' , reply printString , '"\' withCRs , 'SystemNavigation new browseAllCallsOn: (' , reply printString , ' classPool associationAt: #' , symbol , ').'].
>        "pool variables"
> +       classes do: [:each | each sharedPools
> +                       anySatisfy: [:pool | (pool includesKey: symbol)
> -       classes do: [:each | (each sharedPools
> -                       detect: [:pool | (pool includesKey: symbol)
>                                        and:
>                                                [reply := pool.
> +                                               true]]].
> -                                               true]]
> -                       ifNone: [])
> -                       ~~ nil].
>        reply
>                ifNil: [(Undeclared includesKey: symbol)
>                                ifTrue: [^ '"is an undeclared variable.' , '"\' withCRs , 'SystemNavigation new browseAllCallsOn: (Undeclared associationAt: #' , symbol , ').']]
>                ifNotNil:
>                        [classes := WriteStream on: Array new.
>                        self systemNavigation
>                                allBehaviorsDo: [:each | (each sharedPools
>                                                detect:
>                                                        [:pool |
>                                                        pool == reply]
>                                                ifNone: [])
>                                                ~~ nil ifTrue: [classes nextPut: each]].
>                        "Perhaps not print whole list of classes if too long. (unlikely)"
>                        ^ '"is a pool variable from the pool ' , (Smalltalk keyAtIdentityValue: reply) asString , ', which is used by the following classes ' , classes contents printString , '"\' withCRs , 'SystemNavigation new browseAllCallsOn: (' , (Smalltalk keyAtIdentityValue: reply) asString , ' bindingOf: #' , symbol , ').'].
>        ^ nil!
>
>
>