[etoys-dev] Etoys: MorphicExtras-kfr.77.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Feb 11 13:35:07 EST 2013
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!
More information about the etoys-dev
mailing list