'From Squeak3.7gamma of ''17 July 2004'' [latest update: #5976] on 17 July 2004 at 11:09:12 am'! "Change Set: IsSketchMorphFix-nk Date: 12 June 2004 Author: Ned Konz Some cleanup and refactoring: - Replaces all 'isKindOf: SketchMorph' with 'isSketchMorph'. As a result, this also allows new kinds of SketchMorph to be used (this is necessary for Connectors). - Allows sketch morphs (answering true to #isSketchMorph) to not be subinstances of SketchMorph. Does not change the behavior of a stock image. "! !Object methodsFor: 'testing' stamp: 'nk 6/14/2004 16:49'! isSketchMorph ^false! ! !BitmapFillStyle methodsFor: 'Morphic menu' stamp: 'nk 6/12/2004 09:59'! chooseNewGraphicIn: aMorph event: evt "Used by any morph that can be represented by a graphic" | aGraphicalMenu | aGraphicalMenu := GraphicalMenu new initializeFor: self withForms: aMorph reasonableBitmapFillForms coexist: true. aGraphicalMenu selector: #newForm:forMorph:; argument: aMorph. evt hand attachMorph: aGraphicalMenu! ! !ComplexProgressIndicator methodsFor: 'as yet unclassified' stamp: 'nk 6/12/2004 09:23'! addProgressDecoration: extraParam | f m | targetMorph ifNil: [^self]. (extraParam isForm) ifTrue: [targetMorph submorphsDo: [:mm | (mm isSketchMorph) ifTrue: [mm delete]]. f := Form extent: extraParam extent depth: extraParam depth. extraParam displayOn: f. m := SketchMorph withForm: f. m align: m fullBounds leftCenter with: targetMorph fullBounds leftCenter + (2 @ 0). targetMorph addMorph: m. ^self]. (extraParam isMemberOf: String) ifTrue: [targetMorph submorphsDo: [:mm | (mm isKindOf: StringMorph) ifTrue: [mm delete]]. m := StringMorph contents: extraParam. m align: m fullBounds bottomCenter + (0 @ 8) with: targetMorph bounds bottomCenter. targetMorph addMorph: m. ^self]! ! !Morph methodsFor: 'halos and balloon help' stamp: 'nk 6/12/2004 09:32'! wantsSimpleSketchMorphHandles "Answer true if my halo's simple handles should include the simple sketch morph handles." ^false! ! !Morph methodsFor: 'menus' stamp: 'nk 1/6/2004 12:53'! addPaintingItemsTo: aMenu hand: aHandMorph | subMenu movies | subMenu := MenuMorph new defaultTarget: self. subMenu add: 'repaint' translated action: #editDrawing. subMenu add: 'set rotation center' translated action: #setRotationCenter. subMenu add: 'reset forward-direction' translated action: #resetForwardDirection. subMenu add: 'set rotation style' translated action: #setRotationStyle. subMenu add: 'erase pixels of color' translated action: #erasePixelsOfColor:. subMenu add: 'recolor pixels of color' translated action: #recolorPixelsOfColor:. subMenu add: 'reduce color palette' translated action: #reduceColorPalette:. subMenu add: 'add a border around this shape...' translated action: #addBorderToShape:. movies := (self world rootMorphsAt: aHandMorph targetOffset) select: [:m | (m isKindOf: MovieMorph) or: [m isSketchMorph]]. movies size > 1 ifTrue: [subMenu add: 'insert into movie' translated action: #insertIntoMovie:]. aMenu add: 'painting...' translated subMenu: subMenu! ! !Morph methodsFor: 'menus' stamp: 'nk 6/12/2004 09:58'! chooseNewGraphicCoexisting: aBoolean "Allow the user to choose a different form for her form-based morph" | replacee aGraphicalMenu | aGraphicalMenu := GraphicalMenu new initializeFor: self withForms: self reasonableForms coexist: aBoolean. aBoolean ifTrue: [self primaryHand attachMorph: aGraphicalMenu] ifFalse: [replacee := self topRendererOrSelf. replacee owner replaceSubmorph: replacee by: aGraphicalMenu]! ! !Morph methodsFor: 'menus' stamp: 'nk 6/12/2004 22:42'! reasonableBitmapFillForms "Answer an OrderedCollection of forms that could be used to replace my bitmap fill, with my current form first." | reasonableForms myGraphic | reasonableForms := self class allSketchMorphForms. reasonableForms addAll: Imports default images. reasonableForms addAll: (BitmapFillStyle allSubInstances collect:[:f| f form]). reasonableForms remove: (myGraphic := self fillStyle form) ifAbsent: []. reasonableForms := reasonableForms asOrderedCollection. reasonableForms addFirst: myGraphic. ^reasonableForms! ! !Morph methodsFor: 'menus' stamp: 'nk 6/12/2004 09:55'! reasonableForms "Answer an OrderedCollection of forms that could be used to replace my form, with my current form first." | reasonableForms myGraphic | reasonableForms := self class allSketchMorphForms. reasonableForms addAll: Imports default images. reasonableForms remove: (myGraphic := self form) ifAbsent: []. reasonableForms := reasonableForms asOrderedCollection. reasonableForms addFirst: myGraphic. ^reasonableForms! ! !Morph methodsFor: 'testing' stamp: 'nk 6/12/2004 09:17'! isSketchMorph ^self class isSketchMorphClass! ! !EToySenderMorph methodsFor: 'as yet unclassified' stamp: 'nk 6/12/2004 09:23'! fixOldVersion | uName uForm uEmail uIP | uName _ self userName. uForm _ userPicture ifNil: [ (self findDeepSubmorphThat: [ :x | (x isKindOf: ImageMorph) or: [x isSketchMorph]] ifAbsent: [self halt]) form. ]. uEmail _ (fields at: #emailAddress) contents. uIP _ self ipAddress. self userName: uName userPicture: (uForm scaledToSize: 61@53) userEmail: uEmail userIPAddress: uIP ! ! !HaloMorph methodsFor: 'halos and balloon help' stamp: 'nk 6/12/2004 09:34'! addSimpleHandlesTo: aHaloMorph box: aBox | aHandle | simpleMode _ true. target isWorldMorph ifTrue: [^ self addSimpleHandlesForWorldHalos]. self removeAllMorphs. "remove old handles, if any" self bounds: target renderedMorph worldBoundsForHalo. "update my size" self addHandleAt: (((aBox topLeft + aBox leftCenter) // 2) + self simpleFudgeOffset) color: Color paleBuff icon: 'Halo-MoreHandles' on: #mouseDown send: #addFullHandles to: self. aHandle _ self addGraphicalHandle: #Rotate at: aBox bottomLeft on: #mouseDown send: #startRot:with: to: self. aHandle on: #mouseMove send: #doRot:with: to: self. target isFlexMorph ifTrue: [(self addGraphicalHandle: #Scale at: aBox bottomRight on: #mouseDown send: #startScale:with: to: self) on: #mouseMove send: #doScale:with: to: self] ifFalse: [(self addGraphicalHandle: #Scale at: aBox bottomRight on: #mouseDown send: #startGrow:with: to: self) on: #mouseMove send: #doGrow:with: to: self]. innerTarget wantsSimpleSketchMorphHandles ifTrue: [self addSimpleSketchMorphHandlesInBox: aBox]. growingOrRotating _ false. self layoutChanged. self changed. ! ! !HaloMorph methodsFor: 'handles' stamp: 'nk 6/12/2004 09:24'! addChooseGraphicHandle: haloSpec "If the target is a sketch morph, and if the governing preference is set, add a halo handle allowing the user to select a new graphic" (Preferences showChooseGraphicHaloHandle and: [innerTarget isSketchMorph]) ifTrue: [self addHandle: haloSpec on: #mouseDown send: #chooseNewGraphicFromHalo to: innerTarget] ! ! !HaloMorph methodsFor: 'handles' stamp: 'nk 6/12/2004 09:24'! addRepaintHandle: haloSpec (innerTarget isSketchMorph) ifTrue: [self addHandle: haloSpec on: #mouseDown send: #editDrawing to: innerTarget] ! ! !Morph class methodsFor: 'testing' stamp: 'nk 6/12/2004 09:20'! allSketchMorphClasses "Morph allSketchMorphClasses" ^ Array streamContents: [:s | self withAllSubclassesDo: [:cls | cls isSketchMorphClass ifTrue: [s nextPut: cls ]]] ! ! !Morph class methodsFor: 'testing' stamp: 'nk 6/12/2004 09:45'! allSketchMorphForms "Answer a Set of forms of SketchMorph (sub) instances, except those used as button images or ones being edited." | reasonableForms | reasonableForms := Set new. Morph allSketchMorphClasses do: [:cls | cls allInstances do: [:m | ((m owner isKindOf: SketchEditorMorph) or: [m owner isKindOf: IconicButton]) ifFalse: [reasonableForms add: m form]]]. ^ reasonableForms! ! !Morph class methodsFor: 'testing' stamp: 'nk 6/12/2004 09:17'! isSketchMorphClass ^false! ! !MovieMorph methodsFor: 'menu' stamp: 'nk 6/12/2004 09:59'! addCustomMenuItems: aCustomMenu hand: aHandMorph | movies subMenu | super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu addLine. subMenu _ MenuMorph new defaultTarget: self. frameList size > 1 ifTrue: [ subMenu add: 'repaint' translated action: #editDrawing. subMenu add: 'set rotation center' translated action: #setRotationCenter. subMenu add: 'play once' translated action: #playOnce. subMenu add: 'play loop' translated action: #playLoop. subMenu add: 'stop playing' translated action: #stopPlaying. currentFrameIndex > 1 ifTrue: [ subMenu add: 'previous frame' translated action: #previousFrame]. currentFrameIndex < frameList size ifTrue: [ subMenu add: 'next frame' translated action: #nextFrame]]. subMenu add: 'extract this frame' translated action: #extractFrame:. movies _ (self world rootMorphsAt: aHandMorph targetOffset) select: [:m | (m isKindOf: MovieMorph) or: [m isSketchMorph]]. (movies size > 1) ifTrue: [subMenu add: 'insert into movie' translated action: #insertIntoMovie:]. aCustomMenu add: 'movie...' translated subMenu: subMenu ! ! !MovieMorph methodsFor: 'menu' stamp: 'nk 6/12/2004 09:59'! insertIntoMovie: evt | movies aTarget | movies _ (self world rootMorphsAt: evt hand targetOffset) select: [:m | ((m isKindOf: MovieMorph) or: [m isSketchMorph]) and: [m ~= self]]. movies isEmpty ifTrue: [^ self]. aTarget _ movies first. (aTarget isSketchMorph) ifTrue: [aTarget _ aTarget replaceSelfWithMovie]. movies first insertFrames: frameList. self delete. ! ! !Player methodsFor: 'costume' stamp: 'nk 6/12/2004 10:01'! hasOnlySketchCostumes "Answer true if the only costumes assocaited with this Player are SketchMorph costumes" (costume renderedMorph isSketchMorph) ifFalse: [^ false]. costumes ifNotNil: [costumes do: [:cost | (cost isSketchMorph) ifFalse: [^ false]]]. ^ true! ! !Player methodsFor: 'costume' stamp: 'nk 6/12/2004 10:01'! knownSketchCostumeWithSameFormAs: aSketchMorph | itsForm | itsForm := aSketchMorph form. ^ costumes ifNotNil: [costumes detect: [:c | c isSketchMorph and: [c form == itsForm]] ifNone: []]! ! !Player methodsFor: 'costume' stamp: 'nk 6/12/2004 10:01'! recaptureUniqueCostumes "Recapture all unique sketch-like costumes. Debugging only." | unique | costumes ifNil:[^self]. unique := PluggableSet new equalBlock:[:s1 :s2| s1 form == s2 form]; hashBlock:[:s| s form identityHash]. unique addAll: (costumes select:[:c| c isSketchMorph]). unique := unique asIdentitySet. costumes := costumes select:[:c| (c isSketchMorph) not or:[unique includes: c]]. ! ! !Player methodsFor: 'costume' stamp: 'nk 6/12/2004 10:02'! rememberCostume: aCostume "Put aCostume in my remembered-costumes list, as the final element" | costumeToRemember existing | costumeToRemember _ aCostume renderedMorph. "Remember real morphs, not their transformations" costumes ifNil: [costumes _ OrderedCollection new]. existing _ (costumeToRemember isSketchMorph) ifTrue: [self knownSketchCostumeWithSameFormAs: costumeToRemember] ifFalse: [costumes detect: [:c | c == costumeToRemember] ifNone: [nil]]. costumes _ costumes copyWithout: existing. costumes addLast: costumeToRemember! ! !Player methodsFor: 'costume' stamp: 'nk 6/12/2004 10:02'! restoreBaseGraphic "Restore my base graphic" | cos | ((cos _ self costume renderedMorph) isSketchMorph) ifTrue: [cos restoreBaseGraphic]! ! !Player methodsFor: 'misc' stamp: 'nk 6/12/2004 10:00'! adoptScriptsFrom "Let the user click on another object form which the receiver should obtain scripts and code" | aMorph | Sensor waitNoButton. aMorph _ ActiveWorld chooseClickTarget. aMorph ifNil: [^ Beeper beep]. (((aMorph isSketchMorph) and: [aMorph player belongsToUniClass]) and: [self belongsToUniClass not]) ifTrue: [costume acquirePlayerSimilarTo: aMorph player] ifFalse: [self beep]! ! !Player methodsFor: 'misc' stamp: 'nk 6/12/2004 10:01'! impartSketchScripts "Let the user designate another object to which my scripts and code should be imparted" | aMorph | Sensor waitNoButton. aMorph _ ActiveWorld chooseClickTarget. aMorph ifNil: [^ self]. (aMorph renderedMorph isSketchMorph) ifTrue: [aMorph acquirePlayerSimilarTo: self]! ! !Player methodsFor: 'misc' stamp: 'nk 6/12/2004 10:01'! offerAlternateViewerMenuFor: aViewer event: evt "Put up an alternate Viewer menu on behalf of the receiver." | aMenu aWorld | aWorld _ aViewer world. aMenu _ MenuMorph new defaultTarget: self. costumes ifNotNil: [(costumes size > 1 or: [costumes size == 1 and: [costumes first ~~ costume renderedMorph]]) ifTrue: [aMenu add: 'forget other costumes' translated target: self selector: #forgetOtherCostumes]]. aMenu add: 'expunge empty scripts' translated target: self action: #expungeEmptyScripts. aMenu addLine. aMenu add: 'choose vocabulary...' translated target: aViewer action: #chooseVocabulary. aMenu balloonTextForLastItem: 'Choose a different vocabulary for this Viewer.' translated. aMenu add: 'choose limit class...' translated target: aViewer action: #chooseLimitClass. aMenu balloonTextForLastItem: 'Specify what the limitClass should be for this Viewer -- i.e., the most generic class whose methods and categories should be considered here.' translated. aMenu add: 'open standard lexicon' translated target: aViewer action: #openLexicon. aMenu balloonTextForLastItem: 'open a window that shows the code for this object in traditional programmer format' translated. aMenu add: 'open lexicon with search pane' translated target: aViewer action: #openSearchingProtocolBrowser. aMenu balloonTextForLastItem: 'open a lexicon that has a type-in pane for search (not recommended!!)' translated. aMenu addLine. aMenu add: 'inspect morph' translated target: costume selector: #inspect. aMenu add: 'inspect player' translated target: self selector: #inspect. self belongsToUniClass ifTrue: [aMenu add: 'browse class' translated target: self action: #browsePlayerClass. aMenu add: 'inspect class' translated target: self class action: #inspect]. aMenu add: 'inspect this Viewer' translated target: aViewer selector: #inspect. aMenu add: 'inspect this Vocabulary' translated target: aViewer currentVocabulary selector: #inspect. aMenu addLine. aMenu add: 'relaunch this Viewer' translated target: aViewer action: #relaunchViewer. aMenu add: 'view morph directly' translated target: aViewer action: #viewMorphDirectly. aMenu balloonTextForLastItem: 'opens a Viewer directly on the rendered morph.' translated. (costume renderedMorph isSketchMorph) ifTrue: [aMenu addLine. aMenu add: 'impart scripts to...' translated target: self action: #impartSketchScripts]. aMenu popUpEvent: evt in: aWorld! ! !Player methodsFor: 'pen' stamp: 'nk 6/12/2004 10:00'! addPlayerMenuItemsTo: aMenu hand: aHandMorph "Note that these items are primarily available in another way in an object's Viewer" | subMenu | subMenu _ MenuMorph new defaultTarget: self. self getPenDown ifTrue: [subMenu add: 'lift pen' action: #liftPen] ifFalse: [subMenu add: 'lower pen' action: #lowerPen]. subMenu add: 'choose pen size...' action: #choosePenSize. subMenu add: 'choose pen color...' action: #choosePenColor:. aMenu add: 'pen...' subMenu: subMenu. (costume renderedMorph isSketchMorph) ifTrue: [self belongsToUniClass ifFalse: [aMenu add: 'adopt scripts from...' target: self action: #adoptScriptsFrom] ifTrue: [aMenu add: 'impart scripts to...' target: self action: #impartSketchScripts]]! ! !Player methodsFor: 'slot getters/setters' stamp: 'nk 6/12/2004 10:00'! getBaseGraphic "Answer a form representing the receiver's base graphic" | aMorph | ^ ((aMorph _ costume renderedMorph) isSketchMorph) ifTrue: [aMorph baseGraphic] ifFalse: [aMorph imageForm]! ! !Player methodsFor: 'slot getters/setters' stamp: 'nk 6/12/2004 10:00'! getCostume "Answer a form representing the receiver's primary graphic. An earlier wording, disused but may persist in preexisting scripts." | aMorph | ^ ((aMorph _ costume renderedMorph) isSketchMorph) ifTrue: [aMorph form] ifFalse: [aMorph imageForm]! ! !Player methodsFor: 'slot getters/setters' stamp: 'nk 6/12/2004 10:00'! getCostumeAtCursor "Answer the form representing the object at the current cursor. An earlier wording, disused but may persist in preexisting scripts" | anObject aMorph | anObject _ self getValueFromCostume: #valueAtCursor. ^ anObject == 0 "weird return from GraphMorph" ifTrue: [ScriptingSystem formAtKey: #Paint] ifFalse: [((aMorph _ anObject renderedMorph) isSketchMorph) ifTrue: [aMorph form] ifFalse: [anObject imageForm]]! ! !Player methodsFor: 'slot getters/setters' stamp: 'nk 6/12/2004 10:00'! getGraphic "Answer a form representing the receiver's primary graphic" | aMorph | ^ ((aMorph _ costume renderedMorph) isSketchMorph) ifTrue: [aMorph form] ifFalse: [aMorph isPlayfieldLike ifTrue: [aMorph backgroundForm] ifFalse: [aMorph imageForm]]! ! !Player methodsFor: 'slot getters/setters' stamp: 'nk 6/12/2004 10:00'! getGraphicAtCursor "Answer the form representing the object at the current cursor" | anObject aMorph | anObject _ self getValueFromCostume: #valueAtCursor. ^ anObject == 0 "weird return from GraphMorph" ifTrue: [ScriptingSystem formAtKey: #Paint] ifFalse: [((aMorph _ anObject renderedMorph) isSketchMorph) ifTrue: [aMorph form] ifFalse: [aMorph isPlayfieldLike ifTrue: [aMorph backgroundForm] ifFalse: [aMorph imageForm]]]! ! !Player methodsFor: 'slot getters/setters' stamp: 'nk 6/12/2004 10:02'! setBaseGraphic: aGraphic "Set the base graphic" | aMorph | ^ ((aMorph _ costume renderedMorph) isSketchMorph) ifTrue: [aMorph baseGraphic: aGraphic]! ! !Player methodsFor: 'slot getters/setters' stamp: 'nk 6/12/2004 10:02'! setCostume: aForm "Set the receiver's graphic as indicated. An earlier wording, disused but may persist in preexisting scripts." | aMorph | ^ ((aMorph _ costume renderedMorph) isSketchMorph) ifTrue: [aMorph form: aForm] ifFalse: ["what to do?"]! ! !Player methodsFor: 'slot getters/setters' stamp: 'nk 6/12/2004 10:02'! setGraphic: aForm "Set the receiver's graphic as indicated" | aMorph | ^ ((aMorph _ costume renderedMorph) isSketchMorph) ifTrue: [aMorph form: aForm] ifFalse: [aMorph isPlayfieldLike ifTrue: [aMorph backgroundForm: aForm] ifFalse: ["what to do?"]]! ! !ReferenceMorph methodsFor: 'accessing' stamp: 'nk 6/12/2004 10:03'! isCurrentlyGraphical "Answer whether the receiver is currently showing a graphical face" | first | ^submorphs notEmpty and: [((first := submorphs first) isKindOf: ImageMorph) or: [first isSketchMorph]]! ! !SketchMorph methodsFor: 'accessing' stamp: 'nk 6/12/2004 09:32'! wantsSimpleSketchMorphHandles "Answer true if my halo's simple handles should include the simple sketch morph handles." ^self isMemberOf: SketchMorph! ! !SketchMorph methodsFor: 'e-toy support' stamp: 'nk 6/12/2004 10:04'! acquirePlayerSimilarTo: aSketchMorphsPlayer "Retrofit into the receiver a player derived from the existing scripted player of a different morph. Works only between SketchMorphs. Maddeningly complicated by potential for transformations or native sketch-morph scaling in donor or receiver or both" | myName myTop itsTop newTop newSketch | myTop _ self topRendererOrSelf. aSketchMorphsPlayer belongsToUniClass ifFalse: [^ Beeper beep]. itsTop _ aSketchMorphsPlayer costume. (itsTop renderedMorph isSketchMorph) ifFalse: [^ Beeper beep]. newTop _ itsTop veryDeepCopy. "May be a sketch or a tranformation" myName _ myTop externalName. "Snag before the replacement is added to the world, because otherwise that could affect this" newSketch _ newTop renderedMorph. newSketch form: self form. newSketch scalePoint: self scalePoint. newSketch bounds: self bounds. myTop owner addMorph: newTop after: myTop. newTop heading ~= myTop heading ifTrue: "avoids annoying round-off error in what follows" [newTop player setHeading: myTop heading]. (newTop isFlexMorph and: [myTop == self]) ifTrue: [newTop removeFlexShell]. newTop _ newSketch topRendererOrSelf. newTop bounds: self bounds. (newTop isFlexMorph and:[myTop isFlexMorph]) ifTrue:[ "Note: This completely dumps the above #bounds: information. We need to recompute the bounds based on the transform." newTop transform: myTop transform copy. newTop computeBounds]. newTop setNameTo: myName. newTop player class bringScriptsUpToDate. myTop delete! ! !SketchMorph methodsFor: 'menu' stamp: 'nk 6/12/2004 10:04'! insertIntoMovie: evt | movies aTarget | movies _ (self world rootMorphsAt: evt hand targetOffset) select: [:m | ((m isKindOf: MovieMorph) or: [m isSketchMorph]) and: [m ~= self]]. movies isEmpty ifTrue: [^ self]. aTarget _ movies first. (aTarget isSketchMorph) ifTrue: [ aTarget _ aTarget replaceSelfWithMovie]. aTarget insertFrames: (Array with: self). self delete. ! ! !SketchMorph class methodsFor: 'testing' stamp: 'nk 6/12/2004 09:16'! isSketchMorphClass ^true! ! !ThumbnailMorph methodsFor: 'stepping and presenter' stamp: 'nk 6/14/2004 16:47'! step "Optimization: Don't redraw if we're viewing some kind of SketchMorph and its rotated Form hasn't changed." | viewee f | viewee _ self actualViewee. viewee ifNil: [ self stopStepping. ^self ]. (viewee isSketchMorph) ifTrue: [ f _ viewee rotatedForm. f == lastSketchForm ifTrue: [^ self]. lastSketchForm _ f]. self changed. ! ! !SketchMorph class reorganize! ('instance creation' exampleBackgroundSketch fromFile: fromStream: openEditor withForm:) ('new-morph participation' includeInNewMorphMenu) ('scripting' additionsToViewerCategories) ('testing' isSketchMorphClass) ! !Morph class reorganize! ('class initialization' initialize) ('fileIn/Out' fileReaderServicesForFile:suffix: fromFileName: serviceLoadMorphFromFile services) ('initialize-release' unload) ('instance creation' initializedInstance newBounds: newBounds:color: newSticky) ('misc' morphsUnknownToTheirOwners) ('new-morph participation' addPartsDescriptorQuadsTo:if: includeInNewMorphMenu newStandAlone partName:categories:documentation: partName:categories:documentation:sampleImageForm:) ('parts bin' supplementaryPartsDescriptions) ('scripting' additionsToViewerCategoryBasic additionsToViewerCategoryColorAndBorder additionsToViewerCategoryDragAndDrop additionsToViewerCategoryGeometry additionsToViewerCategoryLayout additionsToViewerCategoryMiscellaneous additionsToViewerCategoryMotion additionsToViewerCategoryObservation additionsToViewerCategoryPenUse additionsToViewerCategoryScripting additionsToViewerCategoryScripts additionsToViewerCategoryTests authoringPrototype helpContributions vectorAdditions) ('arrow head size' defaultArrowheadSize obtainArrowheadFor:defaultValue:) ('*flexiblevocabularies-scripting' additionToViewerCategorySelectors additionsToViewerCategories additionsToViewerCategory: allAdditionsToViewerCategories hasAdditionsToViewerCategories noteCompilationOf:meta:) ('*customevents-user events' additionsToViewerCategoryUserEvents) ('*connectors-scripting' additionsToViewerCategoryConnection) ('testing' allSketchMorphClasses allSketchMorphForms isSketchMorphClass) ('*connectorsGraphModel' defaultGraphContextClass defaultGraphModelClass) !