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
etoys-dev@lists.squeakfoundation.org