Etoys: MorphicExtras-kfr.77.mcz

Karl Ramberg uploaded a new version of MorphicExtras to project Etoys:
http://source.squeak.org/etoys/MorphicExtras-kfr.77.mcz

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

Name: MorphicExtras-kfr.77
Author: kfr
Time: 11 February 2013, 7:34:04 pm
UUID: d5a59509-3afd-3c46-a1c3-4c4e804aeef9
Ancestors: MorphicExtras-kfr.76

Fixing issues with flexing FlapTab

=============== Diff against MorphicExtras-kfr.75 ===============

Item was changed:
  ----- Method: FlapTab>>computeEdgeFraction (in category 'edge') -----
  computeEdgeFraction
        "Compute and remember the edge fraction"

        | aBox aFraction |
        self isCurrentlySolid ifTrue: [^ edgeFraction ifNil: [self edgeFraction: 0.5]].

+       aBox := ((self pasteUpMorph ifNil: [self currentWorld]) bounds) insetBy: (self extent // 2).
+       aFraction := self
-       aBox _ ((self pasteUpMorph ifNil: [ActiveWorld]) bounds) insetBy: (self extent // 2).
-       aFraction _ self
                ifVertical:
                        [(self center y - aBox top) / (aBox height max: 1)]
                ifHorizontal:
                        [(self center x - aBox left) / (aBox width max: 1)].
        ^ self edgeFraction: aFraction!

Item was changed:
  ----- Method: FlapTab>>fitOnScreen (in category 'positioning') -----
  fitOnScreen
        "19 sept 2000 - allow flaps in any paste up"
        | constrainer t l |
+       constrainer := self pasteUpMorph ifNil: [self currentWorld].
-       constrainer := self pasteUpMorph ifNil: [self].
        self flapShowing "otherwise no point in doing this"
                ifTrue:[self spanWorld].
        self orientation == #vertical ifTrue: [
+               t := ((self top min: (constrainer bottom- self height)) max: constrainer top).
-               t _ ((self top min: (constrainer bottom- self height)) max: constrainer top).
                t = self top ifFalse: [self top: t].
        ] ifFalse: [
+               l := ((self left min: (constrainer right - self width)) max: constrainer left).
-               l _ ((self left min: (constrainer right - self width)) max: constrainer left).
                l = self left ifFalse: [self left: l].
        ].
        self flapShowing ifFalse: [self positionObject: self atEdgeOf: constrainer].
  !

Item was changed:
  ----- Method: FlapTab>>hideFlap (in category 'show & hide') -----
  hideFlap
        | aWorld |
+       aWorld := self world ifNil: [self currentWorld].
+       self privateDeleteReferent.
-       aWorld _ self world ifNil: [self currentWorld].
-       referent privateDelete.
        aWorld removeAccommodationForFlap: self.
+       flapShowing := false.
-       flapShowing _ false.
        self isInWorld ifFalse: [aWorld addMorphFront: self].
        self adjustPositionAfterHidingFlap.
        aWorld haloMorphs do:
                [:m | m target isInWorld ifFalse: [m delete]]!

Item was changed:
  ----- Method: FlapTab>>maybeHideFlapOnMouseLeaveDragging (in category 'show & hide') -----
  maybeHideFlapOnMouseLeaveDragging
        | aWorld |
        self hasHalo ifTrue: [^ self].
        referent isInWorld ifFalse: [^ self].
        (dragged or: [referent bounds containsPoint: self cursorPoint])
                ifTrue: [^ self].
        aWorld _ self world.
+       self privateDeleteReferent.  "could make me worldless if I'm inboard"
-       referent privateDelete.  "could make me worldless if I'm inboard"
        aWorld ifNotNil: [aWorld removeAccommodationForFlap: self].
+       flapShowing := false.
-       flapShowing _ false.
        self isInWorld ifFalse: [aWorld addMorphFront: self].
        self adjustPositionAfterHidingFlap!

Item was changed:
  ----- Method: FlapTab>>mouseMove: (in category 'event handling') -----
  mouseMove: evt
        "Handle a mouse-move event.   The event, a MorphicEvent, is passed in."

        | aPosition newReferentThickness adjustedPosition thick |

+       dragged ifFalse: [(thick := self referentThickness) > 0
+                       ifTrue: [lastReferentThickness := thick]].
+       ((self containsPoint: (aPosition := evt cursorPoint)) and: [dragged not])
-       dragged ifFalse: [(thick _ self referentThickness) > 0
-                       ifTrue: [lastReferentThickness _ thick]].
-       ((self containsPoint: (aPosition _ evt cursorPoint)) and: [dragged not])
                ifFalse:
                        [flapShowing ifFalse: [self showFlap].
+                       adjustedPosition := aPosition - evt hand targetOffset.
-                       adjustedPosition _ aPosition - evt hand targetOffset.
                        (edgeToAdhereTo == #bottom)
                                ifTrue:
+                                       [newReferentThickness := inboard
-                                       [newReferentThickness _ inboard
                                                ifTrue:
                                                        [self world height - adjustedPosition y]
                                                ifFalse:
                                                        [self world height - adjustedPosition y - self height]].

                        (edgeToAdhereTo == #left)
                                        ifTrue:
+                                               [newReferentThickness :=
-                                               [newReferentThickness _
                                                        inboard
                                                                ifTrue:
                                                                        [adjustedPosition x + self width]
                                                                ifFalse:
                                                                        [adjustedPosition x]].

                        (edgeToAdhereTo == #right)
                                        ifTrue:
+                                               [newReferentThickness :=
-                                               [newReferentThickness _
                                                        inboard
                                                                ifTrue:
                                                                        [self world width - adjustedPosition x]
                                                                ifFalse:
                                                                        [self world width - adjustedPosition x - self width]].

                        (edgeToAdhereTo == #top)
                                        ifTrue:
+                                               [newReferentThickness :=
-                                               [newReferentThickness _
                                                        inboard
                                                                ifTrue:
                                                                        [adjustedPosition y + self height]
                                                                ifFalse:
                                                                        [adjustedPosition y]].

                        self isCurrentlySolid ifFalse:
                                [(#(left right) includes: edgeToAdhereTo)
                                        ifFalse:
                                                [self left: adjustedPosition x]
                                        ifTrue:
                                                [self top: adjustedPosition y]].

                        ((edgeToAdhereTo == #left) and: [(self  valueOfProperty: #rigidThickness) notNil]) ifTrue:
                                [newReferentThickness := referent width].

                        self applyThickness: newReferentThickness.
+                       dragged := true.
-                       dragged _ true.
                        self fitOnScreen.
                        self computeEdgeFraction]!

Item was changed:
  ----- Method: FlapTab>>mouseUp: (in category 'event handling') -----
  mouseUp: evt
        "The mouse came back up, presumably after having dragged the tab.  Caution: if not operating full-screen, this notification can easily be *missed*, which is why the edge-fraction-computation is also being done on mouseMove."

        super mouseUp: evt.
        (self referentThickness <= 0 or:
                [(referent isInWorld and: [(referent boundsInWorld intersects: referent owner boundsInWorld) not])]) ifTrue:
                        [self hideFlap.
+                       flapShowing := false].
-                       flapShowing _ false].
        self fitOnScreen.
        dragged ifTrue:
                [self computeEdgeFraction.
+               dragged := false].
-               dragged _ false].
        Flaps doAutomaticLayoutOfFlapsIfAppropriate!

Item was removed:
- ----- Method: FlapTab>>ownerChanged (in category 'change reporting') -----
- ownerChanged
-       self fitOnScreen.
-       ^super ownerChanged.!

Item was changed:
  ----- Method: FlapTab>>positionObject: (in category 'positioning') -----
  positionObject: anObject
          "anObject could be myself or my referent"

+ "Could consider container := referent pasteUpMorph, to allow flaps on things other than the world, but for the moment, let's skip it!!"
- "Could consider container _ referent pasteUpMorph, to allow flaps on things other than the world, but for the moment, let's skip it!!"

        "19 sept 2000 - going for all paste ups"
+
-
        ^self
                positionObject: anObject
+               atEdgeOf: (self pasteUpMorph ifNil: [^ self currentWorld])!
-               atEdgeOf: (self pasteUpMorph ifNil: [^ self])!

Item was added:
+ ----- Method: FlapTab>>privateDeleteReferent (in category 'show & hide') -----
+ privateDeleteReferent
+       referent isFlexed
+               ifTrue: [referent owner privateDelete]
+               ifFalse: [referent privateDelete]!

Item was changed:
  ----- Method: FlapTab>>spanWorld (in category 'positioning') -----
  spanWorld
        "Make the receiver's height or width commensurate with that of the container."

        | container |

+       container := self pasteUpMorph ifNil: [self currentWorld].
-       container _ self pasteUpMorph ifNil: [self currentWorld].
        (self orientation == #vertical) ifTrue: [
                referent vResizing == #rigid
                        ifTrue:[referent spanContainerVertically: container height].
                referent hResizing == #rigid
                        ifTrue:[referent width: (referent width min: container width - self width)].
                referent top: container top + self referentMargin y.
        ] ifFalse: [
                referent hResizing == #rigid
                        ifTrue:[referent width: container width].
                referent vResizing == #rigid
                        ifTrue:[referent height: (referent height min: container height - self height)].
                referent left: container left + self referentMargin x.
+       ]!
-       ] !

Item was changed:
  RectangleMorph subclass: #GraphMorph
+       instanceVariableNames: 'data dataColor cursor cursorColor cursorColorAtZeroCrossings startIndex minVal maxVal cachedForm hasChanged samplingRate'
-       instanceVariableNames: 'data dataColor cursor cursorColor cursorColorAtZeroCrossings startIndex minVal maxVal cachedForm hasChanged'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'MorphicExtras-Widgets'!

  !GraphMorph commentStamp: '<historical>' prior: 0!
  I display a graph of numbers, normalized so the full range of values just fits my height. I support a movable cursor that can be dragged with the mouse.

  Implementation notes: Some operations on me may be done at sound sampling rates (e.g. 11-44 thousand times/second). To allow such high bandwidth application, certain operations that change my appearance do not immediately report a damage rectangle. Instead, a flag is set indicating that my display needs to refreshed and a step method reports the damage rectangle if that flag is set. Also, I cache a bitmap of my graph to allow the cursor to be moved without redrawing the graph.
  !

Item was added:
+ ----- Method: GraphMorph>>elementCount (in category 'accessing') -----
+ elementCount
+       ^data size!

Item was added:
+ ----- Method: GraphMorph>>getSamplingRate (in category 'accessing') -----
+ getSamplingRate
+       ^samplingRate asString asSymbol!

Item was changed:
  ----- Method: GraphMorph>>initialize (in category 'initialization') -----
  initialize
        "initialize the state of the receiver"
        super initialize.
        ""
        self extent: 365 @ 80.

        dataColor _ Color darkGray.
        cursor _ 1.0.
+       samplingRate := 11025.
        "may be fractional"
        cursorColor _ Color red.
        cursorColorAtZeroCrossings _ Color red.
        startIndex _ 1.
        hasChanged _ false.
        self
                data: ((0 to: 360 - 1)
                                collect: [:x | (100.0 * x degreesToRadians sin) asInteger])!

Item was changed:
  ----- Method: GraphMorph>>play (in category 'commands') -----
  play
+       self playOnce: data size!
-       self playOnce!

Item was changed:
  ----- Method: GraphMorph>>playOnce (in category 'commands') -----
  playOnce

        | scale absV scaledData |
        data isEmpty ifTrue: [^ self].  "nothing to play"
        scale _ 1.
        data do: [:v | (absV _ v abs) > scale ifTrue: [scale _ absV]].
        scale _ 32767.0 / scale.
        scaledData _ SoundBuffer newMonoSampleCount: data size.
+       cursor to: data size do: [:i | scaledData at: i put: (scale * (data at: i)) truncated].
+       SoundService default playSampledSound: scaledData rate: samplingRate.
-       1 to: data size do: [:i | scaledData at: i put: (scale * (data at: i)) truncated].
-       SoundService default playSampledSound: scaledData rate: 11025.
  !

Item was added:
+ ----- Method: GraphMorph>>playOnce: (in category 'commands') -----
+ playOnce: aSampleNumber
+
+       | scale absV scaledData |
+       data isEmpty ifTrue: [^ self].  "nothing to play"
+       scale _ 1.
+       data do: [:v | (absV _ v abs) > scale ifTrue: [scale _ absV]].
+       scale _ 32767.0 / scale.
+       scaledData _ SoundBuffer newMonoSampleCount: data size.
+       cursor to: aSampleNumber do: [:i | scaledData at: i put: (scale * (data at: i)) truncated].
+       SoundService default playSampledSound: scaledData rate: samplingRate.
+ !

Item was added:
+ ----- Method: GraphMorph>>playTo: (in category 'commands') -----
+ playTo: aSampleNumber
+       self playOnce: aSampleNumber!

Item was added:
+ ----- Method: GraphMorph>>samplingRate (in category 'accessing') -----
+ samplingRate
+     ^samplingRate!

Item was added:
+ ----- Method: GraphMorph>>samplingRate: (in category 'accessing') -----
+ samplingRate: aSamplingRate
+       ((SamplingRate resolutions) includes:  aSamplingRate) ifFalse: [^ self].
+       samplingRate:= aSamplingRate!

Item was added:
+ ----- Method: GraphMorph>>setSamplingRate: (in category 'accessing') -----
+ setSamplingRate: aSymbol
+       samplingRate :=  aSymbol asString asNumber!

Item was added:
+ ----- Method: Player>>getSamplingRate (in category '*MorphicExtras-Widgets') -----
+ getSamplingRate
+       ^ self getValueFromCostume: #getSamplingRate!

Item was added:
+ ----- Method: Player>>playTo: (in category '*MorphicExtras-Widgets') -----
+ playTo: aSampleNumber
+       costume renderedMorph playTo: aSampleNumber!

Item was added:
+ ----- Method: Player>>setSamplingRate: (in category '*MorphicExtras-Widgets') -----
+ setSamplingRate: aSymbol
+       costume renderedMorph setSamplingRate: aSymbol!

Item was added:
+ SymbolListType subclass: #SamplingRate
+       instanceVariableNames: ''
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'MorphicExtras-Widgets'!

Item was added:
+ ----- Method: SamplingRate>>initialize (in category 'as yet unclassified') -----
+ initialize
+       "Vocabulary initialize"
+       super initialize.
+       self vocabularyName: #SamplingRate.
+       symbols := #('11025' '22050' '44100')
+
+ !

Item was added:
+ ----- Method: SamplingRate>>representsAType (in category 'as yet unclassified') -----
+ representsAType
+       ^true!

_______________________________________________
etoys-dev mailing list
[hidden email]
http://lists.squeakland.org/mailman/listinfo/etoys-dev