'From Squeak3.3alpha of 12 January 2002 [latest update: #4767] on 20 February 2002 at 11:46:05 pm'! "Change Set: tileFixes-sw Date: 20 February 2002 Author: Scott Wallace Concerning 'classic' tile scripting: ¥ Phrases with reference-valued arguments, when getting prepared for immediate execution by the yellow !! 'do-it' button, had been getting compiled with the wrong referent; this is now fixed. ¥ Makes scaleFactor work more reasonably in the problematical case of scaled but unflexed SketchMorphs. ¥ Make the Dot (which provides a plausible sample-value for any reference-valued slot or reference-valued argument) now be rather more noticeable -- and much less likely to be grown to huge scaleFactor that might cause problems when it's applied to a much larger graphic after a costume change. ¥ Fixes the bug that if an object were renamed to a non-legal-symbol name *after* a uniqueNameForReference had already been given out for it, the new name was not vetted for legal format before it blithely got replaced in the References dictionary -- this could lead to quite a dizzying variety of errors. ¥ Include the look-like tiles in the graphics category (formerly had only been in 'miscellaneous'.) ¥ Bulletproofs MessageSend.value against nil arguments -- for some reason an error condition has recently been arising sporadically during routine Scriptor use, with nil arguments always the cause. CAUTION: the Squeakland update stream requires a different version of this update. This changeset is for mainstream Squeak 3.3a, *not* for Squeakland."! !Object methodsFor: 'viewer' stamp: 'sw 2/20/2002 12:14'! uniqueNameForReferenceFrom: proposedName "Answer a satisfactory symbol, similar to the proposedName but obeying the rules, to represent the receiver" | aName nameSym stem knownClassVars | proposedName = self uniqueNameForReferenceOrNil ifTrue: [^ proposedName]. "No change" stem _ proposedName select: [:ch | ch isLetter or: [ch isDigit]]. stem size == 0 ifTrue: [stem _ 'A']. stem first isLetter ifFalse: [stem _ 'A', stem]. stem _ stem capitalized. knownClassVars _ ScriptingSystem allKnownClassVariableNames. aName _ Utilities keyLike: stem satisfying: [:jinaLake | nameSym _ jinaLake asSymbol. ((References definedNames includesKey: nameSym) not and: [(Module root moduleDefining: nameSym) isNil]) and: [(knownClassVars includes: nameSym) not]]. References defineName: (aName _ aName asSymbol) as: self export: true. ^ aName! ! !MessageSend methodsFor: 'evaluating' stamp: 'sw 2/20/2002 22:17'! value "Send the message and answer the return value" arguments ifNil: [^ receiver perform: selector]. "Note: recently, errors have been observed when dragging tiles over a Scriptor layout, with arguments nil, thus occasioning the above patch" ^ receiver perform: selector withArguments: (self collectArguments: arguments)! ! !Morph methodsFor: 'accessing' stamp: 'sw 2/15/2002 02:10'! scaleFactor "Answer a number characterizing my own internal idea of what my scale-factor it." ^ 1.0 ! ! !Morph methodsFor: 'naming' stamp: 'sw 2/20/2002 12:21'! renameTo: aName "Set Player name in costume. Update Viewers. Fix all tiles (old style). fix References. New tiles: recompile, and recreate open scripts. If coming in from disk, and have name conflict, References will already have new name." | aPresenter putInViewer aPasteUp renderer oldKey assoc classes oldName | oldName _ self knownName. (renderer _ self topRendererOrSelf) setNameTo: aName. putInViewer _ false. ((aPresenter _ self presenter) isNil or: [renderer player isNil]) ifFalse: [putInViewer _ aPresenter currentlyViewing: renderer player. putInViewer ifTrue: [renderer player viewerFlapTab hibernate]]. "empty it temporarily" (aPasteUp _ self topPasteUp) ifNotNil: [aPasteUp allTileScriptingElements do: [:m | m bringUpToDate]]. "Fix References dictionary. See restoreReferences to know why oldKey is already aName, but oldName is the old name." oldKey _ References definedNames keyAtIdentityValue: renderer player ifAbsent: [nil]. oldKey ifNotNil: [assoc _ References definedNames associationAt: oldKey. oldKey = aName ifFalse: ["normal rename" assoc key: (renderer player uniqueNameForReferenceFrom: aName). References definedNames rehash]]. putInViewer ifTrue: [aPresenter viewMorph: self]. "recreate my viewer" oldKey ifNil: [^ aName]. "Force strings in tiles to be remade with new name. New tiles only." Preferences universalTiles ifFalse: [^ aName]. classes _ (Smalltalk allCallsOn: assoc) collect: [ :each | each classSymbol]. (classes asSet) do: [:clsName | (Smalltalk at: clsName) replaceSilently: oldName to: aName]. "replace in text body of all methods. Can be wrong!!" "Redo the tiles that are showing. This is also done in caller in unhibernate." aPasteUp ifNotNil: [ aPasteUp allTileScriptingElements do: [:mm | "just ScriptEditorMorphs". (mm isKindOf: ScriptEditorMorph) ifTrue: [((mm playerScripted class compiledMethodAt: mm scriptName) hasLiteral: assoc) ifTrue: [mm hibernate; unhibernate]]]]. ^ aName! ! !Player methodsFor: 'slot getters/setters' stamp: 'sw 2/15/2002 02:37'! getScaleFactor "Answer the scale factor of the object" ^ self costume scaleFactor! ! !SketchMorph methodsFor: 'accessing' stamp: 'sw 2/20/2002 01:34'! scaleFactor "Answer the number representing my scaleFactor, assuming the receiver to be unflexed (if flexed, the renderer's scaleFactor is called instead" | qty | ((qty _ self scalePoint) isKindOf: Point) ifTrue: [^ 1.0]. ^ qty! ! !SketchMorph class methodsFor: 'scripting' stamp: 'sw 2/15/2002 02:16'! additionsToViewerCategories "Answer a list of ( ) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." ^ #((graphics ( (slot graphic 'The picture currently being worn' Graphic readWrite Player getGraphic Player setGraphic:) (command wearCostumeOf: 'wear the costume of...' Player) (slot baseGraphic 'The picture originally painted for this object, but can subsequently be changed via menu or script' Graphic readWrite Player getBaseGraphic Player setBaseGraphic:) (command restoreBaseGraphic 'Make my picture be the one I remember in my baseGraphic') ))) ! ! !StandardScriptingSystem methodsFor: 'form dictionary' stamp: 'sw 2/20/2002 01:09'! patchInNewStandardPlayerForm "Patch in a darker and larger representation of a Dot. No senders -- called from the postscript of an update" "ScriptingSystem patchInNewStandardPlayerForm" FormDictionary at: #standardPlayer put: (Form extent: 13@13 depth: 16 fromArray: #( 0 0 0 65536 0 0 0 0 0 65537 65537 65536 0 0 0 65537 65537 65537 65537 65536 0 0 65537 65537 65537 65537 65536 0 1 65537 65537 65537 65537 65537 0 1 65537 65537 65537 65537 65537 0 65537 65537 65537 65537 65537 65537 65536 1 65537 65537 65537 65537 65537 0 1 65537 65537 65537 65537 65537 0 0 65537 65537 65537 65537 65536 0 0 65537 65537 65537 65537 65536 0 0 0 65537 65537 65536 0 0 0 0 0 65536 0 0 0) offset: 0@0)! ! !TileMorph methodsFor: 'accessing' stamp: 'sw 2/15/2002 01:47'! playerBearingCode "Answer the actual Player object who will be the 'self' when the receiver is being asked to generate code" self topEditor ifNotNilDo: [:anEditor | ^ anEditor playerScripted]. (self nearestOwnerThat: [:m | m isAViewer]) ifNotNilDo: [:aViewer | ^ aViewer scriptedPlayer]. ^ actualObject! ! !TransformationMorph methodsFor: 'accessing' stamp: 'sw 2/15/2002 02:27'! scaleFactor "Answer the scaleFactor" ^ transform scale! ! "Postscript:" ScriptingSystem patchInNewStandardPlayerForm. UnscriptedPlayer allInstancesDo: [:p | (p costume externalName beginsWith: 'dot') ifTrue: [(p costume isKindOf: ImageMorph) ifTrue: [p costume image: (ScriptingSystem formAtKey: #standardPlayer)]]].!