Re: [etoys-dev] Etoys: MorphicExtras-kfr.77.mcz

Hm, GraphMorph should not really be part of this...

On Mon, Feb 11, 2013 at 7:34 PM, commits@source.squeak.org wrote:

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 etoys-dev@squeakland.org http://lists.squeakland.org/mailman/listinfo/etoys-dev