'From Squeak3.7-m17n of 21 July 2004 [latest update: #19] on 25 July 2004 at 3:48:07 pm'! "Change Set: e12ArrowDeltaCtl-sw Date: 7 July 2004 Author: Scott Wallace and Diego Gomez Deck Adopted from update 0221 on Squeakland. Allows a morph, or the system at large, to specify the arrow-delta to be used for readouts associated with a specific getter. To do this, either: (1) Modify Morph.arrowDeltatFor: to specify an arrow-delta that should apply to a given selector for *any* morph in which it is used. (2) Reimplement #arrowDeltaFor: in a specific morph class. See SimpleSliderMorph's implementation of this method, which can be re-enabled to demonstrate the feature. Also a little fixup to the related floatPrecision facility."! !Morph methodsFor: 'scripting' stamp: 'dgd 7/4/2004 12:41'! arrowDeltaFor: aGetSelector "Answer a number indicating the default arrow delta to be used in a numeric readout with the given get-selector. This is a hook that subclasses of Morph can reimplement." aGetSelector == #getScaleFactor ifTrue: [^ 0.1]. ^ 1! ! !CategoryViewer methodsFor: 'entries' stamp: 'sw 7/4/2004 01:09'! readoutFor: partName type: partType readOnly: readOnly getSelector: getSelector putSelector: putSelector "Answer a readout morph for the given part" | readout delta | readout _ (Vocabulary vocabularyForType: partType) updatingTileForTarget: scriptedPlayer partName: partName getter: getSelector setter: putSelector. (partType == #Number) ifTrue: [(delta _ scriptedPlayer arrowDeltaFor: getSelector) = 1 ifFalse: [readout setProperty: #arrowDelta toValue: delta]. scriptedPlayer setFloatPrecisionFor: readout updatingStringMorph]. readout step. ^ readout! ! !Player methodsFor: 'misc' stamp: 'sw 7/4/2004 00:20'! arrowDeltaFor: aGetSelector "Answer the arrowDelta to use in conjunction with a readout for aGetSelector, which will be of the form 'getXXX'" costume ifNotNil: [^ costume renderedMorph arrowDeltaFor: aGetSelector]. ^ 1 "For the future, possibly: If we want the SlotInformation for a user-defined slot to be able to specify a standard arrowDelta for that slot, we'd include something like the following... | aSlotName slotInfo | aSlotName _ Utilities inherentSelectorForGetter: aGetSelector. (slotInfo _ self slotInfoAt: aSlotName ifAbsent: [nil]) ifNotNil: [^ slotInfo arrowDelta]." ! ! !Player methodsFor: 'misc' stamp: 'sw 7/4/2004 00:29'! defaultFloatPrecisionFor: aGetSelector "Answer the float position to use in conjunction with a readout for aGetSelector, which will be of the form 'getXXX'" | aSlotName slotInfo | aSlotName _ Utilities inherentSelectorForGetter: aGetSelector. (slotInfo _ self slotInfoAt: aSlotName ifAbsent: [nil]) ifNotNil: [^ slotInfo floatPrecision]. self costume ifNotNil: [^ self costume renderedMorph defaultFloatPrecisionFor: aGetSelector]. ^ 1! ! !Player methodsFor: 'slots-user' stamp: 'sw 7/4/2004 00:26'! setFloatPrecisionFor: aReadout "If appropriate, set the floatPrecision for the given watcher readout (an UpdatingStringMorph), whose getter is assumed already to be established." | precision | (precision _ self defaultFloatPrecisionFor: aReadout getSelector) ~= 1 ifTrue: [aReadout floatPrecision: precision]! ! !Player methodsFor: 'slots-user' stamp: 'sw 7/4/2004 01:37'! tearOffFancyWatcherFor: aGetter "Hand the user a labeled readout for viewing a numeric value" | aWatcher aTile aLine aColor aTower ms slotMsg info isNumeric anInterface watcherWording delta | info _ self slotInfoForGetter: aGetter. info ifNotNil: [isNumeric _ info type == #Number. watcherWording _ Utilities inherentSelectorForGetter: aGetter] ifNil: [anInterface _Vocabulary eToyVocabulary methodInterfaceAt: aGetter ifAbsent: [nil]. isNumeric _ anInterface notNil and: [anInterface resultType == #Number]. watcherWording _ anInterface elementWording]. aColor _ Color r: 0.387 g: 0.581 b: 1.0. aWatcher _ UpdatingStringMorph new. aWatcher growable: true; getSelector: aGetter; putSelector: (info notNil ifTrue: [ScriptingSystem setterSelectorForGetter: aGetter] ifFalse: [anInterface companionSetterSelector]). aWatcher target: self. isNumeric ifTrue: "at the moment, actually, only numeric is allowed" [aTile _ NumericReadoutTile new typeColor: aColor. self setFloatPrecisionFor: aWatcher. (delta _ self arrowDeltaFor: aGetter) ~= 1 ifTrue: [aTile setProperty: #arrowDelta toValue: delta]]. aTile addMorphBack: aWatcher. aTile addArrows. aTile setLiteralTo: (self perform: aGetter) width: 30. Preferences universalTiles ifTrue: [ ms _ MessageSend receiver: self selector: aGetter asSymbol arguments: #(). slotMsg _ ms asTilesIn: self class globalNames: (self class officialClass ~~ CardPlayer). "For CardPlayers, use 'self'. For others, name it, and use its name." ms _ MessageSend receiver: 3 selector: #= asSymbol arguments: #(5). aLine _ ms asTilesIn: self class globalNames: false. aLine firstSubmorph delete. aLine addMorphFront: slotMsg. aLine lastSubmorph delete. aLine lastSubmorph delete. aLine color: aColor. aLine addMorphBack: aTile. aLine cellPositioning: #leftCenter] ifFalse: [ aLine _ AlignmentMorph newRow hResizing: #shrinkWrap; vResizing: #shrinkWrap; color: aColor. aLine layoutInset: -1. aLine borderWidth: 1; borderColor: aColor darker. aLine addMorphBack: (self tileReferringToSelf borderWidth: 0; typeColor: aColor; color: aColor; bePossessive). aLine addTransparentSpacerOfSize: (4@0). aTower _ AlignmentMorph newColumn color: aColor. aTower addTransparentSpacerOfSize: (0 @ 1). aTower addMorphBack: (StringMorph contents: watcherWording, ' = ' font: ScriptingSystem fontForTiles). aLine addMorphBack: aTower. aLine addMorphBack: aTile]. aWatcher step; fitContents. aLine openInHand! ! !Player methodsFor: 'slots-user' stamp: 'sw 7/4/2004 01:05'! tearOffWatcherFor: aSlotGetter "Tear off a simple textual watcher for the slot whose getter is provided" | aWatcher anInterface info isNumeric | info _ self slotInfoForGetter: aSlotGetter. info ifNotNil: [isNumeric _ info type == #Number] ifNil: [anInterface _ Vocabulary eToyVocabulary methodInterfaceAt: aSlotGetter ifAbsent: [nil]. isNumeric _ anInterface notNil and: [anInterface resultType == #Number]]. aWatcher _ UpdatingStringMorph new. aWatcher growable: true; getSelector: aSlotGetter; putSelector: (info notNil ifTrue: [ScriptingSystem setterSelectorForGetter: aSlotGetter] ifFalse: [anInterface companionSetterSelector]); setNameTo: (info notNil ifTrue: [Utilities inherentSelectorForGetter: aSlotGetter] ifFalse: [anInterface elementWording]); target: self. isNumeric ifFalse: [aWatcher useStringFormat] ifTrue: [self setFloatPrecisionFor: aWatcher]. aWatcher step; fitContents; openInHand! ! !SimpleSliderMorph methodsFor: 'e-toy support' stamp: 'sw 7/4/2004 01:53'! arrowDeltaFor: aGetter "Here just for testing the arrowDelta feature. To test, re-enable the code below by commenting out the first line, and you should see the minVal slot of the slider go up and down in increments of 5 as you work the arrows on its readout tile in a freshly-launched Viewer or detailed watcher" true ifTrue: [^ super arrowDeltaFor: aGetter]. ^ (aGetter == #getMinVal) ifTrue: [5] ifFalse: [1]! ! !TileMorph methodsFor: 'accessing' stamp: 'sw 7/4/2004 01:09'! updatingStringMorph "If the receiver has an updatingStringMorph as a submorph, answer it, else answer nil" ^ submorphs detect: [:m | m isKindOf: UpdatingStringMorph] ifNone: [nil]! !