'From Squeak3.2alpha of 4 October 2001 [latest update: #4474] on 6 November 2001 at 8:48:07 am'! "Change Set: Stack-OM2-tk Date: 4 November 2001 Author: Ted Kaehler Allow UpdatingStringMorphs to be edited with the target and putSelector are nil. So we can use it as a number holder in a NumericReadoutTile in a FancyWatcher. Many fixes to #abstractAModel and #wrapWithAStack. Added Basic category to Object Tool, changed look of Rectangle, bordered Text, three kinds of number readout. "! CardPlayer subclass: #CardPlayer51 instanceVariableNames: 'scrollingField2 scrollingField1 ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-UserObjects'! !ObjectsTool commentStamp: 'tk 11/5/2001 15:36' prior: 0! I am a Master Parts Bin that allows the user to drag out a new Morph from a voluminous iconic list. Choose "objects" from the world menu, or type Alt-o (Cmd-o on the Mac). To add a new kinds of Morphs: In the class of the Morph, implement the message: descriptionForPartsBin ^ self partName: 'Rectangle' categories: #('Graphics' ' Basic 1 ') documentation: 'A rectangular shape, with border and fill style' The partName is the title that will show in the lower pane of the Object Tool. When is categories mode, an object can be seen in more than one category. The list above tells which ones. Documentation is what will show in the balloon help for each object thumbnail. The message #initializeToStandAlone creates the actual instance. To make a second variant object prototype coming from the same class, implement #supplementaryPartsDescriptions. In it, you get to specify the nativitySelector. It is sent to the class to get the variant objects. Often it is #authoringPrototype. (A class may supply supplementaryPartsDescriptions without implementing descriptionForPartsBin. This gives you better control.) ! !UpdatingStringMorph commentStamp: 'tk 11/4/2001 09:31' prior: 0! A StringMorph that constantly tries to show the current data from the target object. When sent #step, it shows what the target objects has (target perform: getSelector). When edited (with shift-click), it writes back to the target. floatPrecision = 1. to round to integer. floatPrecision = .1 to round to 1 decimal place, etc. Even when ((target == nil) or: [getSelector == nil]), the user would still like to edit the string with shift-click.! !Morph methodsFor: 'card in a stack' stamp: 'tk 11/4/2001 21:56'! abstractAModel "Find data-containing fields in me. Make a new class, whose instance variables are named for my fields, and whose values are the values I am showing. Use a CardPlayer for now. Force the user to name the fields. Make slots for text, Number Watchers, SketchMorphs, and ImageMorphs." | instVarNames unnamed ans player twoListsOfMorphs holdsSepData docks oldPlayer iVarName | (oldPlayer _ self player) ifNotNil: [ oldPlayer belongsToUniClass ifTrue: ["Player" oldPlayer class instVarNames size > 0 ifTrue: [ self inform: 'I already have a regular Player, so I can''t have a CardPlayer'. ^ true]]]. twoListsOfMorphs _ StackMorph discoverSlots: self. holdsSepData _ twoListsOfMorphs first. instVarNames _ ''. holdsSepData do: [:ea | iVarName _ Utilities wellFormedInstanceVariableNameFrom: ea knownName. iVarName = ea knownName ifFalse: [ea name: iVarName]. instVarNames _ instVarNames, iVarName, ' ']. unnamed _ twoListsOfMorphs second. "have default names" instVarNames size = 0 ifTrue: [ self inform: 'No named fields were found. Please get a halo on each field and give it a name. Labels or non-data fields should be named "shared xxx".'. ^ false]. unnamed size > 0 ifTrue: [ ans _ PopUpMenu confirm: 'Data fields are ', instVarNames printString, ('\Some fields are not named. Are they labels or non-data fields?', '\Please get a halo on each data field and give it a name.') withCRs trueChoice: 'All other fields are non-data fields' falseChoice: 'Stop. Let me give a name to some more fields'. ans ifFalse: [^ false]]. unnamed withIndexDo: [:mm :ind | mm setName: 'shared label ', ind printString]. "Make a Player with instVarNames. Make me be the costume" player _ CardPlayer instanceOfUniqueClassWithInstVarString: instVarNames andClassInstVarString: ''. self player: player. player costume: self. "Fill in the instance values. Make docks first." docks _ OrderedCollection new. holdsSepData do: [:morph | morph setProperty: #shared toValue: true. "in case it is deeply embedded" morph setProperty: #holdsSeparateDataForEachInstance toValue: true. player class compileInstVarAccessorsFor: morph knownName. morph isSyntaxMorph ifTrue: [morph setTarget: player]. "hookup the UpdatingString!!" docks addAll: morph variableDocks]. player class newVariableDocks: docks. docks do: [:dd | dd storeMorphDataInInstance: player]. "oldPlayer class mdict do: [:assoc | move to player]. move methods to new class?" "oldPlayer become: player." ^ true "success"! ! !Morph methodsFor: 'card in a stack' stamp: 'tk 11/4/2001 20:57'! wrapWithAStack "Install me as a card inside a new stack. The stack has no border or controls, so I my look is unchanged. If I don't already have a CardPlayer, find my data fields and make one. Be ready to make new cards in the stack that look like me, but hold different field data." self player class officialClass == CardPlayer ifFalse: [ self abstractAModel ifFalse: [^ false]]. StackMorph new initializeWith: self. self stack addHalo. "Makes it easier for the user"! ! !PaintInvokingMorph class methodsFor: 'as yet unclassified' stamp: 'tk 11/5/2001 12:19'! supplementaryPartsDescriptions ^ {DescriptionForPartsBin formalName: 'Paint' categoryList: #(' Basic 1 ') documentation: 'Drop this icon to start painting a new object.' globalReceiverSymbol: #PaintInvokingMorph nativitySelector: #authoringPrototype}! ! !RectangleMorph methodsFor: 'initialization' stamp: 'tk 11/6/2001 08:20'! defaultColor "Answer the color that should be set for the receiver by default" ^ Color r: 0.613 g: 0.903 b: 1.0! ! !NumericReadoutTile methodsFor: 'initialization' stamp: 'tk 11/5/2001 14:48'! initializeToStandAlone "Enclose my prototype in a SyntaxMorph. For the ObjectTool" | aWatcher aTile aLine aColor ms slotMsg | super initializeToStandAlone. aColor _ Color r: 0.387 g: 0.581 b: 1.0. aTile _ self typeColor: aColor. aWatcher _ UpdatingStringMorph new. aWatcher growable: true; getSelector: nil; putSelector: nil. aWatcher target: nil. aTile addMorphBack: aWatcher. aTile addArrows. aTile setLiteralTo: 5 width: 30. ms _ MessageSend receiver: nil selector: #aNumber arguments: #(). slotMsg _ ms asTilesIn: Player globalNames: false. "For CardPlayers, use 'aPlayer'. For others, name it, and use its name." ms _ MessageSend receiver: 3 selector: #= asSymbol arguments: #(5). aLine _ ms asTilesIn: Player globalNames: false. aLine firstSubmorph delete. "A little over-complicated? Yes?" aLine addMorphFront: (slotMsg submorphs second) firstSubmorph. aLine addMorphFront: (Morph new transparentSpacerOfSize: 3@3). aLine lastSubmorph delete. aLine lastSubmorph delete. aLine color: aColor. aLine addMorphBack: (Morph new transparentSpacerOfSize: 3@3). aLine addMorphBack: aTile. aLine cellPositioning: #leftCenter. aWatcher step; fitContents. ^ aLine markAsPartsDonor.! ! !RectangleMorph class methodsFor: 'as yet unclassified' stamp: 'tk 11/6/2001 08:23'! roundRectPrototype ^ self authoringPrototype useRoundedCorners color: Color white darker; setNameTo: 'RoundRect'! ! !RectangleMorph class methodsFor: 'parts bin' stamp: 'tk 11/5/2001 13:12'! descriptionForPartsBin ^ self partName: 'Rectangle' categories: #('Graphics' ' Basic 1 ') documentation: 'A rectangular shape, with border and fill style'! ! !RectangleMorph class methodsFor: 'parts bin' stamp: 'tk 11/5/2001 13:12'! supplementaryPartsDescriptions ^ {DescriptionForPartsBin formalName: 'RoundRect' categoryList: #('Graphics' ' Basic 1 ') documentation: 'A rectangle with rounded corners' globalReceiverSymbol: #RectangleMorph nativitySelector: #roundRectPrototype}! ! !NumericReadoutTile class methodsFor: 'instance creation' stamp: 'tk 11/5/2001 15:39'! authoringPrototype "Enclose my prototype in a SyntaxMorph." | aWatcher aTile aLine aColor ms slotMsg | aColor _ Color r: 0.387 g: 0.581 b: 1.0. aTile _ self new typeColor: aColor. aWatcher _ UpdatingStringMorph new. aWatcher growable: true; getSelector: nil; putSelector: nil. aWatcher target: nil. aTile addMorphBack: aWatcher. aTile addArrows. aTile setLiteralTo: 5 width: 30. "This is the long way around to do this..." ms _ MessageSend receiver: nil selector: #aNumber arguments: #(). slotMsg _ ms asTilesIn: Player globalNames: false. "For CardPlayers, use 'aPlayer'. For others, name it, and use its name." ms _ MessageSend receiver: 3 selector: #= asSymbol arguments: #(5). aLine _ ms asTilesIn: Player globalNames: false. aLine firstSubmorph delete. aLine addMorphFront: (slotMsg submorphs second) firstSubmorph. aLine addMorphFront: (Morph new transparentSpacerOfSize: 3@3). aLine lastSubmorph delete. aLine lastSubmorph delete. aLine color: aColor. aLine addMorphBack: (Morph new transparentSpacerOfSize: 3@3). aLine addMorphBack: aTile. aLine cellPositioning: #leftCenter. aWatcher step; fitContents. ^ aLine markAsPartsDonor.! ! !NumericReadoutTile class methodsFor: 'instance creation' stamp: 'tk 11/6/2001 08:44'! borderedPrototype "Just number and up/down arrows" | aWatcher aTile | aTile _ self new typeColor: (Color r: 0.387 g: 0.581 b: 1.0). aWatcher _ UpdatingStringMorph new. aWatcher growable: true. aTile addMorphBack: aWatcher. aTile addArrows. aTile setLiteralTo: 5 width: 30. aWatcher step; fitContents. ^ aTile extent: 30@24; markAsPartsDonor! ! !NumericReadoutTile class methodsFor: 'instance creation' stamp: 'tk 11/6/2001 08:40'! simplePrototype "Bare number readout. Will keep up to data with a number once it has target, getterSelector, setterSelector." ^ (UpdatingStringMorph new) contents: '5'; growable: true; step; fitContents; markAsPartsDonor! ! !NumericReadoutTile class methodsFor: 'instance creation' stamp: 'tk 11/6/2001 08:13'! supplementaryPartsDescriptions ^ {DescriptionForPartsBin formalName: 'Number (fancy)' categoryList: #(' Basic 1 ') documentation: 'A number readout for a Stack. Shows current value. Click and type the value. Shift-click on title to edit.' globalReceiverSymbol: #NumericReadoutTile nativitySelector: #authoringPrototype. DescriptionForPartsBin formalName: 'Number (bare)' categoryList: #(' Basic 1 ') documentation: 'A number readout for a Stack. Shows current value. Click and type the value.' globalReceiverSymbol: #NumericReadoutTile nativitySelector: #simplePrototype. DescriptionForPartsBin formalName: 'Number (mid)' categoryList: #(' Basic 1 ') documentation: 'A number readout for a Stack. Shows current value. Click and type the value.' globalReceiverSymbol: #NumericReadoutTile nativitySelector: #borderedPrototype}! ! !StackMorph methodsFor: 'initialization' stamp: 'tk 11/5/2001 08:48'! initializeWith: aCardMorph "Install the card inside a new stack. Make no border or controls, so I the card's look is unchanged. Card already has a CardPlayer." | wld | wld _ aCardMorph world. self initialize. self pageSize: aCardMorph extent. self borderWidth: 0; layoutInset: 0; color: Color transparent. pages _ Array with: aCardMorph. currentPage _ aCardMorph. cards _ OrderedCollection with: currentPage currentDataInstance. currentPage beAStackBackground. self position: aCardMorph position. submorphs last delete. self addMorph: currentPage. self showPageControls: self fullControlSpecs. wld addMorph: self. ! ! !StackMorph methodsFor: 'controls' stamp: 'tk 11/5/2001 08:21'! fullControlSpecs "Answer specifications for the long form of iconic stack/book controls" ^ #( spacer variableSpacer ('-' deleteCard 'Delete this card') spacer ( 'Ç' goToFirstCardOfStack 'First card') spacer ( '<' goToPreviousCardInStack 'Previous card') spacer ('¥' invokeBookMenu 'Click here to get a menu of options for this stack.') "spacer ('¦' reshapeBackground 'Reshape') " spacer ('¤' showDesignationsOfObjects 'Show designations') spacer ('>' goToNextCardInStack 'Next card') spacer ( 'È' goToLastCardOfStack 'Final card') spacer ('+' insertCard 'Add a new card after this one') variableSpacer ('×' fewerPageControls 'Fewer controls (if shift key pressed, deletes controls)') )! ! !StackMorph class methodsFor: 'misc' stamp: 'tk 11/4/2001 22:08'! discoverSlots: aMorph "Examine the parts of the morph for ones that couldHoldSeparateData. Return a pair of lists: Named morphs, and unnamed morphs (which may be labels, and non-data). Examine all submorphs." | named unnamed got | named _ OrderedCollection new. unnamed _ OrderedCollection new. aMorph submorphsDo: [:direct | got _ false. direct allMorphsDo: [:sub | sub couldHoldSeparateDataForEachInstance ifTrue: [ sub knownName ifNotNil: [ (sub knownName beginsWith: 'shared' "label") ifFalse: [ named add: sub. got _ true]]]]. got ifFalse: [unnamed add: direct]]. ^ Array with: named with: unnamed ! ! !SyntaxMorph methodsFor: 'accessing' stamp: 'tk 11/5/2001 08:32'! externalName ^ self knownName ifNil: [ parseNode ifNil: ['Syntax -- (extra layer)'] ifNotNil: [self parseNode class printString]]! ! !SyntaxMorph methodsFor: 'card & stack' stamp: 'tk 11/4/2001 21:47'! setTarget: aPlayer "Find my UpdatingStringMorph and set its getSelector, putSelector, and target" | updatingString | (updatingString _ self readOut) ifNil: [^ self]. updatingString putSelector: (Utilities setterSelectorFor: self knownName). updatingString getSelector: (Utilities getterSelectorFor: self knownName). updatingString target: aPlayer. ! ! !SyntaxMorph methodsFor: 'card & stack' stamp: 'tk 11/4/2001 21:31'! variableDocks "Answer a list of VariableDock objects for docking up my data with an instance held in my containing playfield. For a numeric-readout tile." "Is CardPlayer class holding my variableDock, or should I be using the caching mechanism in Morph>>variableDocks?" | updatingString | (updatingString _ self readOut) ifNil: [^ #()]. ^ Array with: (VariableDock new variableName: (updatingString getSelector allButFirst: 3) withFirstCharacterDownshifted type: #number definingMorph: updatingString morphGetSelector: #valueFromContents morphPutSelector: #acceptValue:)! ! !TextMorph class methodsFor: 'parts bin' stamp: 'tk 11/5/2001 12:51'! authoringPrototype | t | t _ super authoringPrototype. t contents: 'Abcdef\To get a halo of controls,\Alt-click (Command-click on a Mac)' withCRs asText. "Strangeness here in order to avoid two offset copies of the default contents when operating in an mvc project before cursor enters the morphic window" t paragraph. ^ t! ! !TextMorph class methodsFor: 'parts bin' stamp: 'tk 11/5/2001 13:07'! borderedPrototype | t | t _ self authoringPrototype. t autoFit: false; extent: 250@100. t borderWidth: 1; margins: 4@0. "Strangeness here in order to avoid two offset copies of the default contents when operating in an mvc project before cursor enters the morphic window" t paragraph. ^ t! ! !TextMorph class methodsFor: 'parts bin' stamp: 'tk 11/5/2001 12:52'! descriptionForPartsBin ^ self partName: 'Text' categories: #('Text' ' Basic 1 ') documentation: 'A raw piece of text which you can edit into anything you want'! ! !TextMorph class methodsFor: 'parts bin' stamp: 'tk 11/5/2001 12:55'! supplementaryPartsDescriptions ^ {DescriptionForPartsBin formalName: 'Text (border)' categoryList: #(' Basic 1 ' 'Text') documentation: 'A text field with border' globalReceiverSymbol: #TextMorph nativitySelector: #borderedPrototype} ! ! !TrashCanMorph class methodsFor: 'miscellaneous' stamp: 'tk 11/5/2001 15:41'! descriptionForPartsBin ^ self partName: 'Trash' categories: #('Useful' ' Basic 1 ') documentation: 'a tool for discarding objects'! ! !UpdatingStringMorph methodsFor: 'editing' stamp: 'tk 11/4/2001 09:37'! handlerForMouseDown: evt | h | h _ super handlerForMouseDown: evt. h == self ifTrue:[^self]. "I would get it anyways" "Note: This is a hack to allow value editing in viewers" (owner wantsKeyboardFocusFor: self) ifTrue: [^self]. ^h! ! !UpdatingStringMorph methodsFor: 'editing' stamp: 'tk 11/4/2001 09:36'! mouseDown: evt (owner wantsKeyboardFocusFor: self) ifTrue: [(owner respondsTo: #parseNode) ifTrue:[minimumWidth _ (49 max: minimumWidth)]. "leave space for editing" self launchMiniEditor: evt]! ! UpdatingStringMorph removeSelector: #wantsSteps! !TextMorph class reorganize! ('class initialization' initialize) ('scripting' additionsToViewerCategories) ('user interface' includeInNewMorphMenu) ('parts bin' authoringPrototype borderedPrototype descriptionForPartsBin exampleBackgroundField exampleBackgroundLabel supplementaryPartsDescriptions) ! NumericReadoutTile class removeSelector: #descriptionForPartsBin! NumericReadoutTile class removeSelector: #initializeToStandAlone! !NumericReadoutTile class reorganize! ('instance creation' authoringPrototype borderedPrototype simplePrototype supplementaryPartsDescriptions) ! NumericReadoutTile removeSelector: #wantsKeyboardFocusFor:!