[squeak-dev] The Trunk: MorphicExtras-ar.68.mczcommits at source.squeak.org commits at source.squeak.orgSun Jan 3 23:47:07 UTC 2010
Andreas Raab uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-ar.68.mcz ==================== Summary ==================== Name: MorphicExtras-ar.68 Author: ar Time: 4 January 2010, 12:45:49 pm UUID: 5c154bde-ad67-5c49-92d5-be9bc33111db Ancestors: MorphicExtras-nice.66 Make Etoys unloadable: Move lots of methods to Etoys package. Remove the old Fabrik remnants. =============== Diff against MorphicExtras-nice.66 =============== Item was changed: ----- Method: ViewerFlapTab>>unhibernate (in category 'transition') ----- unhibernate "recreate my viewer" | wasShowing viewer | + referent ifNotNil: [(referent isViewer) ifNotNil: [^self]]. - referent ifNotNil: [(referent findA: Viewer) ifNotNil: [^self]]. wasShowing := flapShowing. "guard against not-quite-player-players" viewer := ((scriptedPlayer respondsTo: #costume) and: [scriptedPlayer costume isMorph]) ifTrue: [self presenter viewMorph: scriptedPlayer costume] ifFalse: [self presenter viewObjectDirectly: scriptedPlayer]. wasShowing ifFalse: [self hideFlap]. ^viewer! Item was changed: + MorphicModel subclass: #TwoWayScrollPane - ComponentLikeModel subclass: #TwoWayScrollPane instanceVariableNames: 'getMenuSelector getMenuTitleSelector xScrollBar yScrollBar scroller' classVariableNames: '' poolDictionaries: '' category: 'MorphicExtras-Obsolete'! !TwoWayScrollPane commentStamp: '<historical>' prior: 0! TwoWayScrollPane is now obsolete. You should be able to use ScrollPane to do both vertical and horizontal scrolling. As an example, see Morph>>inATwoWayScrollPane and change the first line to create a ScrollPane instead of a TwoWayScrollPane. It will still work. (EllipseMorph new extent: 200 at 150) inATwoWayScrollPane openInWorld Note that user preferences for ScrollPane may be geared toward text scrolling, so that the horizontal scrollbar may be hidden when not needed, while the vertical scrollbar is always shown. Use ScrollPane>>alwaysShowHScrollbar: or its variants to adjust this if you want the vertical & horizontal scrollbars to be shown consistently. ! Item was changed: ----- Method: ProjectNavigationMorph>>findSomethingOnSuperSwiki (in category 'the buttons') ----- findSomethingOnSuperSwiki | projectServers server index | projectServers := ServerDirectory projectServers. projectServers isEmpty ifTrue: [^self]. projectServers size = 1 ifTrue: [server := projectServers first] ifFalse: [index := UIManager default chooseFrom: (projectServers collect: [:each | (ServerDirectory nameForServer: each) translatedIfCorresponds]) title: 'Choose a super swiki:' translated. index > 0 ifTrue: [server := projectServers at: index] ifFalse: [^self]]. + Smalltalk at: #EToyProjectQueryMorph ifPresent:[:aClass| aClass onServer: server].! - EToyProjectQueryMorph onServer: server! Item was changed: ----- Method: AlignmentMorphBob1>>simpleToggleButtonFor:attribute:help: (in category 'as yet unclassified') ----- simpleToggleButtonFor: target attribute: attribute help: helpText + ^(Smalltalk at: #EtoyUpdatingThreePhaseButtonMorph ifAbsent:[^Morph new]) - ^(EtoyUpdatingThreePhaseButtonMorph checkBox) target: target; actionSelector: #toggleChoice:; arguments: {attribute}; getSelector: #getChoice:; setBalloonText: helpText; step ! Item was changed: ----- Method: RecordingControlsMorph>>makeTile (in category 'button commands') ----- makeTile "Make a tile representing my sound. Get a sound-name from the user by which the sound is to be known." + | newStyleTile sndName tile tileClass | + tileClass := Smalltalk at: #SoundTile ifAbsent:[nil]. - | newStyleTile sndName tile | recorder verifyExistenceOfRecordedSound ifFalse: [^ self]. recorder pause. + newStyleTile := tileClass notNil. - newStyleTile := true. newStyleTile ifTrue: [sndName := UIManager default request: 'Please name your new sound' translated initialAnswer: 'sound' translated. sndName isEmpty ifTrue: [^ self]. sndName := SampledSound unusedSoundNameLike: sndName. SampledSound addLibrarySoundNamed: sndName samples: recorder condensedSamples samplingRate: recorder samplingRate. + tile := tileClass new literal: sndName] - tile := SoundTile new literal: sndName] ifFalse: [tile := InterimSoundMorph new sound: (SampledSound samples: recorder condensedSamples samplingRate: recorder samplingRate)]. tile bounds: tile fullBounds. tile openInHand! Item was changed: ----- Method: ProjectSorterMorph>>insertNewProject: (in category 'as yet unclassified') ----- insertNewProject: evt | newProj | [newProj := MorphicProject openViewOn: nil.] on: ProjectViewOpenNotification do: [ :ex | ex resume: false]. + Smalltalk at: #EToyProjectDetailsMorph ifPresent:[:aClass| + aClass + getFullInfoFor: newProj + ifValid: [ + evt hand attachMorph: (self sorterMorphForProjectNamed: newProj name) + ] + expandedFormat: false. + ].! - EToyProjectDetailsMorph - getFullInfoFor: newProj - ifValid: [ - evt hand attachMorph: (self sorterMorphForProjectNamed: newProj name) - ] - expandedFormat: false. - - - ! Item was changed: ----- Method: ViewerFlapTab>>hibernate (in category 'transition') ----- hibernate "drop my viewer to save space when writing to the disk." referent submorphs do: + [:m | (m isViewer) ifTrue: [m delete]]! - [:m | (m isKindOf: Viewer) ifTrue: [m delete]]! Item was changed: ----- Method: InternalThreadNavigationMorph>>insertNewProject (in category 'navigation') ----- insertNewProject | newProj | [newProj := MorphicProject openViewOn: nil.] on: ProjectViewOpenNotification do: [ :ex | ex resume: false]. + Smalltalk at: #EToyProjectDetailsMorph ifPresent:[:aClass| + aClass + getFullInfoFor: newProj + ifValid: [self insertNewProjectActionFor: newProj] + expandedFormat: false. + ]. - EToyProjectDetailsMorph - getFullInfoFor: newProj - ifValid: [self insertNewProjectActionFor: newProj] - expandedFormat: false. - ! Item was changed: ----- Method: ProjectNavigationMorph>>gotoAnother (in category 'the actions') ----- gotoAnother + Smalltalk at: #EToyProjectHistoryMorph ifPresent:[:aClass| aClass new openInWorld].! - EToyProjectHistoryMorph new openInWorld! Item was changed: ----- Method: ProjectNavigationMorph>>editProjectInfo (in category 'the actions') ----- editProjectInfo + Smalltalk at: #EToyProjectDetailsMorph ifPresent:[:aClass| + aClass + getFullInfoFor: (self world ifNil: [^self]) project + ifValid: [] + expandedFormat: true + ].! - EToyProjectDetailsMorph - getFullInfoFor: (self world ifNil: [^self]) project - ifValid: [] - expandedFormat: true - ! Item was removed: - ----- Method: Component>>addVariableNamed: (in category 'variables') ----- - addVariableNamed: varName - "Adjust name if necessary and add it" - - | otherNames i partName | - otherNames := self class allInstVarNames. - i := nil. - - [partName := i isNil - ifTrue: [varName] - ifFalse: [varName , i printString]. - otherNames includes: partName] - whileTrue: [i := i isNil ifTrue: [1] ifFalse: [i + 1]]. - self class addInstVarName: partName. - - "Now compile read method and write-with-change method" - self class - compile: (String streamContents: - [:s | - s - nextPutAll: partName; - cr; - tab; - nextPutAll: '^' , partName]) - classified: 'view access' - notifying: nil. - self class - compile: (String streamContents: - [:s | - s - nextPutAll: partName , 'Set: newValue'; - cr; - tab; - nextPutAll: partName , ' _ newValue.'; - cr; - tab; - nextPutAll: 'self changed: #' , partName , '.'; - cr; - tab; - nextPutAll: '^ true' "for components that expect a boolean for accept"]) - classified: 'view access' - notifying: nil. - ^Array with: partName asSymbol with: (partName , 'Set:') asSymbol! Item was removed: - ----- Method: PinMorph>>removeVariableAccess (in category 'variables') ----- - removeVariableAccess - pinSpec modelReadSelector: nil modelWriteSelector: nil. - component initFromPinSpecs! Item was removed: - PolygonMorph subclass: #WireMorph - instanceVariableNames: 'pins' - classVariableNames: 'InputPinForm IoPinForm OutputPinForm' - poolDictionaries: '' - category: 'MorphicExtras-Components'! Item was removed: - ----- Method: Component>>initComponentIn: (in category 'initialize') ----- - initComponentIn: aLayout - model := aLayout model. - self nameMeIn: aLayout world. - self color: Color lightCyan. - self showPins. - model addDependent: self! Item was removed: - ----- Method: PinMorph>>hasVariable (in category 'variables') ----- - hasVariable - ^ pinSpec hasVariable! Item was removed: - ----- Method: Component>>chooseNameLike: (in category 'naming') ----- - chooseNameLike: someName - | stem otherNames i partName | - stem := someName. - (stem size > 5 and: [stem endsWith: 'Morph']) - ifTrue: [stem := stem copyFrom: 1 to: stem size - 5]. - stem := stem first asLowercase asString , stem allButFirst. - otherNames := self class allInstVarNames asSet. - "otherNames addAll: self world allKnownNames." - i := 1. - [otherNames includes: (partName := stem , i printString)] - whileTrue: [i := i + 1]. - partName := UIManager default request: 'Please give this part a name' - initialAnswer: partName. - partName isEmpty ifTrue: [^ nil]. - (otherNames includes: partName) ifTrue: - [self inform: 'Sorry, that name is already used'. - ^ nil]. - ^ partName! Item was removed: - ----- Method: PinMorph>>connectedPins (in category 'wires') ----- - connectedPins - ^ wires collect: [:w | w otherPinFrom: self]! Item was removed: - ----- Method: PinMorph>>unwire (in category 'wires') ----- - unwire - "Remove wires one by one. Not fastest, but by far simplest" - - wires do: [:w | w delete]. "This is where all the work is done"! Item was removed: - ----- Method: PinMorph>>updateImage (in category 'geometry') ----- - updateImage - "pinForm was made for right side. Rotate/flip for other sides" - - bounds left < owner bounds left ifTrue: "left side" - [^ self image: (pinForm flipBy: #horizontal centerAt: 0 at 0)]. - bounds bottom > owner bounds bottom ifTrue: "bottom" - [^ self image: ((pinForm rotateBy: #left centerAt: 0 at 0) - flipBy: #vertical centerAt: 0 at 0)]. - bounds right > owner bounds right ifTrue: "right side" - [^ self image: pinForm]. - bounds top < owner bounds top ifTrue: "top" - [^ self image: (pinForm rotateBy: #left centerAt: 0 at 0)]. - self halt: 'uncaught pin geometry case'! Item was removed: - ----- Method: ListComponent>>changeModelSelection: (in category 'model access') ----- - changeModelSelection: anInteger - "Change the model's selected item index to be anInteger." - - setIndexSelector - ifNil: ["If model is not hooked up to index, then we won't get - an update, so have to do it locally." - self selectionIndex: anInteger] - ifNotNil: [model perform: setIndexSelector with: anInteger]. - selectedItem := anInteger = 0 ifTrue: [nil] ifFalse: [self getListItem: anInteger]. - setSelectionSelector ifNotNil: - [model perform: setSelectionSelector with: selectedItem]! Item was removed: - ----- Method: DSCPostscriptCanvas>>fullDrawBookMorph: (in category 'morph drawing') ----- - fullDrawBookMorph: aBookMorph - " draw all the pages in a book morph, but only if it is the top-level morph " - - morphLevel = 1 ifFalse: [^ super fullDrawBookMorph: aBookMorph]. - - "Unfortunately, the printable 'pages' of a StackMorph are the cards, but for a BookMorph, they are the pages. Separate the cases here." - (aBookMorph isKindOf: StackMorph) - ifTrue: [ - aBookMorph cards do: [:aCard | - aBookMorph goToCard: aCard. "cause card-specific morphs to be installed" - pages := pages + 1. - target print: '%%Page: '; write: pages; space; write: pages; cr. - self drawPage: aBookMorph currentPage]] - ifFalse: [ - aBookMorph pages do: [:aPage | - pages := pages + 1. - target print: '%%Page: '; write: pages; space; write: pages; cr. - self drawPage: aPage]]. - morphLevel = 0 ifTrue: [ self writeTrailer: pages ]. - ! Item was removed: - ----- Method: ComponentLayout>>createCustomModel (in category 'model') ----- - createCustomModel - "Create a model object for this world if it does not yet have one. - The default model for an EditView is a Component." - - model isNil ifFalse: [^self]. "already has a model" - model := Component newSubclass new! Item was removed: - ----- Method: PrintComponent>>accept (in category 'menu commands') ----- - accept - "Inform the model of text to be accepted, and return true if OK." - - | textToAccept | - self canDiscardEdits ifTrue: [^self flash]. - setTextSelector isNil ifTrue: [^self]. - textToAccept := textMorph asText. - model perform: setTextSelector - with: (Compiler evaluate: textToAccept logged: false). - self setText: textToAccept. - self hasUnacceptedEdits: false! Item was removed: - ----- Method: FunctionComponent>>fire (in category 'button') ----- - fire - | arguments newValue | - outputSelector ifNil: [^outputValue := nil]. - functionSelector ifNil: [^outputValue := nil]. - arguments := inputSelectors - collect: [:s | s ifNil: [nil] ifNotNil: [model perform: s]]. - newValue := (arguments findFirst: [:a | a isNil]) = 0 - ifTrue: [model perform: functionSelector withArguments: arguments] - ifFalse: [nil]. - newValue = outputValue - ifFalse: - [model perform: outputSelector with: newValue. - outputValue := newValue]! Item was removed: - ----- Method: PinSpec>>isOutputOnly (in category 'accessing') ----- - isOutputOnly - direction = #output ifTrue: [^ true]. - direction = #ioAsOutput ifTrue: [^ true]. - ^ false! Item was removed: - ----- Method: PinSpec>>modelWriteSelector (in category 'accessing') ----- - modelWriteSelector - ^ modelWriteSelector! Item was removed: - ----- Method: PinMorph>>mouseDown: (in category 'event handling') ----- - mouseDown: event - "Unshifted action is to move the pin (see mouseMove:)" - event shiftPressed ifTrue: [self startWiring: event]. - ! Item was removed: - ----- Method: PinSpec>>isInputOutput (in category 'accessing') ----- - isInputOutput - ^ direction = #inputOutput! Item was removed: - ----- Method: PinMorph>>placeFromSpec (in category 'geometry') ----- - placeFromSpec - | side corners c1 c2 | - side := pinSpec pinLoc asInteger. "1..4 ccw from left" - corners := owner bounds corners. - c1 := corners at: side. - c2 := corners atWrap: side+1. - self position: (c1 + (c2 - c1 * pinSpec pinLoc fractionPart)). - self updateImage.! Item was removed: - ----- Method: TextComponent>>initPinSpecs (in category 'components') ----- - initPinSpecs - pinSpecs := Array - with: (PinSpec new pinName: 'text' direction: #inputOutput - localReadSelector: nil localWriteSelector: nil - modelReadSelector: getTextSelector modelWriteSelector: setTextSelector - defaultValue: 'some text' pinLoc: 1.5)! Item was removed: - ----- Method: FunctionComponent>>update: (in category 'updating') ----- - update: aSymbol - inputSelectors do: - [:s | aSymbol = s ifTrue: [^ self fire]].! Item was removed: - ----- Method: FunctionComponent>>initPinSpecs (in category 'components') ----- - initPinSpecs - pinSpecs := Array - with: (PinSpec new pinName: 'output' direction: #output - localReadSelector: nil localWriteSelector: nil - modelReadSelector: nil modelWriteSelector: nil - defaultValue: nil pinLoc: 3.5) - with: (PinSpec new pinName: 'a' direction: #input - localReadSelector: nil localWriteSelector: nil - modelReadSelector: nil modelWriteSelector: nil - defaultValue: nil pinLoc: 1.5) - ! Item was removed: - ----- Method: WireMorph>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - handles isNil ifTrue: [self addHandles] ifFalse: [self removeHandles]! Item was removed: - PluggableListMorph subclass: #ListComponent - instanceVariableNames: 'selectedItem setSelectionSelector' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Components'! Item was removed: - ----- Method: PinMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - - ^ (evt yellowButtonPressed | evt blueButtonPressed) not - ! Item was removed: - ----- Method: ComponentLayout>>allKnownNames (in category 'submorphs-accessing') ----- - allKnownNames - ^super allKnownNames - , (self submorphs collect: [:m | m knownName] thenSelect: [:m | m notNil])! Item was removed: - ----- Method: ComponentLayout>>addCustomMenuItems:hand: (in category 'menus') ----- - addCustomMenuItems: menu hand: aHandMorph - - super addCustomMenuItems: menu hand: aHandMorph. - menu addLine. - menu add: 'inspect model in morphic' translated action: #inspectModelInMorphic! Item was removed: - ----- Method: Component>>removeVariableNamed: (in category 'variables') ----- - removeVariableNamed: varName - self class removeSelector: varName. - self class removeSelector: (varName , 'Set:') asSymbol. - self class removeInstVarName: varName asString! Item was removed: - ----- Method: PinMorph>>shareVariableOf: (in category 'variables') ----- - shareVariableOf: otherPin - pinSpec modelReadSelector: otherPin pinSpec modelReadSelector - modelWriteSelector: otherPin pinSpec modelWriteSelector. - component initFromPinSpecs! Item was removed: - ----- Method: FunctionComponent>>headerString (in category 'as yet unclassified') ----- - headerString - ^ String streamContents: - [:s | - | ps | - s nextPutAll: self knownName. - 2 to: pinSpecs size do: - [:i | ps := pinSpecs at: i. - s nextPutAll: ps pinName , ': '; - nextPutAll: ps pinName , ' ']. - s cr; tab; nextPutAll: '^ ']! Item was removed: - ----- Method: Component class>>addSlotNamed: (in category 'as yet unclassified') ----- - addSlotNamed: aName - (self allInstVarNames includes: aName) ifTrue: [self error: 'Duplicate slot name']. - self addInstVarName: aName. - ! Item was removed: - ----- Method: ComponentLayout>>initialize (in category 'initialization') ----- - initialize - super initialize. - self createCustomModel. - self extent: 384 at 256! Item was removed: - ----- Method: WireMorph>>pinMoved (in category 'as yet unclassified') ----- - pinMoved - | newVerts | - newVerts := vertices copy. - newVerts at: 1 put: pins first wiringEndPoint. - newVerts at: newVerts size put: pins last wiringEndPoint. - self setVertices: newVerts! Item was removed: - ----- Method: PinMorph>>addWire: (in category 'wires') ----- - addWire: aWireMorph - wires add: aWireMorph! Item was removed: - ----- Method: TextComponent>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - self extent: 144 @ 42! Item was removed: - ----- Method: PinMorph>>initialize (in category 'initialization') ----- - initialize - super initialize. - wires := OrderedCollection new! Item was removed: - ----- Method: FunctionComponent>>accept (in category 'menu commands') ----- - accept - "Inform the model of text to be accepted, and return true if OK." - | textToAccept oldSelector | - oldSelector := functionSelector. - textToAccept := textMorph asText. - textToAccept = self getText ifTrue: [^ self]. "No body to compile yet" - functionSelector := model class - compile: self headerString , textToAccept asString - classified: 'functions' notifying: nil. - self setText: textToAccept. - self hasUnacceptedEdits: false. - oldSelector ifNotNil: - [functionSelector = oldSelector ifFalse: [model class removeSelector: oldSelector]]. - self fire! Item was removed: - ----- Method: ScrollableField class>>additionsToViewerCategories (in category 'scripting') ----- - additionsToViewerCategories - ^ TextMorph additionsToViewerCategories! Item was removed: - ----- Method: BookMorph>>chooseAndRevertToVersion (in category 'scripting') ----- - chooseAndRevertToVersion - | time which | - "Let the user choose an older version for all code in MethodMorphs in this book. Run through that code and revert each one to that time." - - self methodHolders. "find them in me" - self methodHolderVersions. - which := UIManager default chooseFrom: #('leave as is'), VersionNames title: - 'Put all scripts in this book back - the way they were at this time:'. - which <= 1 ifTrue: [^ self]. - time := VersionTimes at: which-1. - self revertToCheckpoint: time.! Item was removed: - ----- Method: PinSpec>>pinLoc: (in category 'accessing') ----- - pinLoc: x - pinLoc := x! Item was removed: - ----- Method: PinMorph>>addModelVariable (in category 'variables') ----- - addModelVariable - | accessors | - accessors := component model addVariableNamed: component knownName , pinSpec pinName. - pinSpec modelReadSelector: accessors first modelWriteSelector: accessors second. - component initFromPinSpecs. - self connectedPins do: [:connectee | connectee shareVariableOf: self]! Item was removed: - ----- Method: PinSpec>>localReadSelector (in category 'accessing') ----- - localReadSelector - ^ localReadSelector! Item was removed: - ----- Method: PinSpec>>variableName (in category 'variables') ----- - variableName - ^ modelReadSelector! Item was removed: - ----- Method: PinSpec>>hasVariable (in category 'variables') ----- - hasVariable - ^modelReadSelector notNil or: [modelWriteSelector notNil]! Item was removed: - ----- Method: Component>>justDroppedInto:event: (in category 'drag and drop') ----- - justDroppedInto: aMorph event: anEvent - | theModel | - theModel := aMorph model. - ((aMorph isKindOf: ComponentLayout) - and: [theModel isKindOf: Component]) ifFalse: - ["Disconnect prior to removal by move" - (theModel isKindOf: Component) ifTrue: [self unwire. model := nil]. - ^ super justDroppedInto: aMorph event: anEvent]. - theModel == model ifTrue: [^ self "Presumably just a move"]. - self initComponentIn: aMorph. - super justDroppedInto: aMorph event: anEvent.! Item was removed: - ----- Method: PinMorph class>>initialize (in category 'class initialization') ----- - initialize "PinMorph initialize" - OutputPinForm := Form extent: 8 at 8 depth: 1 fromArray: - #( 0 3221225472 4026531840 4227858432 4278190080 4227858432 4026531840 3221225472) - offset: 0 at 0. - - IoPinForm := Form extent: 8 at 8 depth: 1 fromArray: - #( 0 402653184 1006632960 2113929216 4278190080 2113929216 1006632960 402653184) - offset: 0 at 0. - - InputPinForm := OutputPinForm flipBy: #horizontal centerAt: 0 at 0. - ! Item was removed: - ----- Method: ListComponent>>initPinSpecs (in category 'components') ----- - initPinSpecs - pinSpecs := Array - with: (PinSpec new pinName: 'list' direction: #input - localReadSelector: nil localWriteSelector: nil - modelReadSelector: getListSelector modelWriteSelector: nil - defaultValue: #(one two three) pinLoc: 1.5) - with: (PinSpec new pinName: 'index' direction: #inputOutput - localReadSelector: nil localWriteSelector: nil - modelReadSelector: getIndexSelector modelWriteSelector: setIndexSelector - defaultValue: 0 pinLoc: 2.5) - with: (PinSpec new pinName: 'selectedItem' direction: #output - localReadSelector: nil localWriteSelector: nil - modelReadSelector: nil modelWriteSelector: setSelectionSelector - defaultValue: nil pinLoc: 3.5)! Item was removed: - ----- Method: PinMorph>>wireTo: (in category 'wires') ----- - wireTo: otherPin - "Note must return true or false indicating success" - - (otherPin isNil or: [otherPin == self]) ifTrue: [^false]. - self hasVariable - ifTrue: - [otherPin hasVariable - ifTrue: [self mergeVariableWith: otherPin] - ifFalse: [otherPin shareVariableOf: self]] - ifFalse: - [otherPin hasVariable - ifTrue: [self shareVariableOf: otherPin] - ifFalse: - [self addModelVariable. - otherPin shareVariableOf: self]]. - component model changed: pinSpec modelReadSelector. - ^true! Item was removed: - ----- Method: PasteUpMorph class>>additionsToViewerCategories (in category '*MorphicExtras-scripting') ----- - additionsToViewerCategories - "Answer a list of (<categoryName> <list of category specs>) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." - - ^ # ( - - (playfield ( - (command initiatePainting 'Initiate painting of a new object in the standard playfield.') - (slot mouseX 'The x coordinate of the mouse pointer' Number readWrite Player getMouseX unused unused) - (slot mouseY 'The y coordinate of the mouse pointer' Number readWrite Player getMouseY unused unused) - (command roundUpStrays 'Bring all out-of-container subparts back into view.') - (slot graphic 'The graphic shown in the background of this object' Graphic readWrite Player getGraphic Player setGraphic:) - (command unhideHiddenObjects 'Unhide all hidden objects.'))) - - (scripting ( - (command tellAllContents: 'Send a message to all the objects inside the playfield' ScriptName))) - - (collections ( - (slot cursor 'The index of the chosen element' Number readWrite Player getCursor Player setCursorWrapped:) - (slot count 'How many elements are within me' Number readOnly Player getCount unused unused) - (slot stringContents 'The characters of the objects inside me, laid end to end' String readOnly Player getStringContents unused unused) - (slot playerAtCursor 'the object currently at the cursor' Player readWrite Player getValueAtCursor unused unused) - (slot firstElement 'The first object in my contents' Player readWrite Player getFirstElement Player setFirstElement:) - (slot numberAtCursor 'the number at the cursor' Number readWrite Player getNumberAtCursor Player setNumberAtCursor: ) - (slot graphicAtCursor 'the graphic worn by the object at the cursor' Graphic readOnly Player getGraphicAtCursor unused unused) - (command tellAllContents: 'Send a message to all the objects inside the playfield' ScriptName) - (command removeAll 'Remove all elements from the playfield') - (command shuffleContents 'Shuffle the contents of the playfield') - (command append: 'Add the object to the end of my contents list.' Player) - (command prepend: 'Add the object at the beginning of my contents list.' Player) - (command includeAtCursor: 'Add the object to my contents at my current cursor position' Player) - (command include: 'Add the object to my contents' Player) - )) - - (#'stack navigation' ( - (command goToNextCardInStack 'Go to the next card') - (command goToPreviousCardInStack 'Go to the previous card') - (command goToFirstCardInBackground 'Go to the first card of the current background') - (command goToFirstCardOfStack 'Go to the first card of the entire stack') - (command goToLastCardInBackground 'Go to the last card of the current background') - (command goToLastCardOfStack 'Go to the last card of the entire stack') - (command deleteCard 'Delete the current card') - (command insertCard 'Create a new card'))) - - "(viewing ( - (slot viewingNormally 'whether contents are viewed normally' Boolean readWrite Player getViewingByIcon Player setViewingByIcon: )))" - - (#'pen trails' ( - (command liftAllPens 'Lift the pens on all the objects in my interior.') - (command lowerAllPens 'Lower the pens on all the objects in my interior.') - (command trailStyleForAllPens: 'Set the trail style for pens of all objects within' TrailStyle) - (command clearTurtleTrails 'Clear all the pen trails in the interior.')))) - ! Item was removed: - ----- Method: WireMorph>>addHandles (in category 'editing') ----- - addHandles - super addHandles. - "Don't show endpoint handles" - handles first delete. - handles last delete! Item was removed: - ----- Method: WireMorph>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - ^ evt buttons noMask: 16r78 "ie no modifier keys pressed"! Item was removed: - ----- Method: TextComponent>>initComponentIn: (in category 'components') ----- - initComponentIn: aLayout - super initComponentIn: aLayout. - self setText: self getText! Item was removed: - ImageMorph subclass: #PinMorph - instanceVariableNames: 'component pinForm pinSpec wires' - classVariableNames: 'InputPinForm IoPinForm OutputPinForm' - poolDictionaries: '' - category: 'MorphicExtras-Components'! Item was removed: - ----- Method: PinSpec>>defaultValue (in category 'accessing') ----- - defaultValue - ^ defaultValue! Item was removed: - ----- Method: BookMorph>>installRollBackButtons (in category 'scripting') ----- - installRollBackButtons - | all | - "In each script in me, put a versions button it the upper right." - - all := IdentitySet new. - self allMorphsAndBookPagesInto: all. - all := all select: [:mm | mm class = MethodMorph]. - all do: [:mm | mm installRollBackButtons: self].! Item was removed: - ----- Method: PinMorph>>startWiring: (in category 'wires') ----- - startWiring: event - "Start wiring from this pin" - - | origin candidates handle candidate | - origin := self wiringEndPoint. - candidates := OrderedCollection new. - "Later this could be much faster if we define pinMorphsDo: - so that it doesn't go too deep and bypasses non-widgets." - self pasteUpMorph allMorphsDo: - [:m | - ((m isMemberOf: PinMorph) and: [m canDockWith: self]) - ifTrue: [candidates add: m]]. - handle := NewHandleMorph new - followHand: event hand - forEachPointDo: - [:newPoint | | wiringColor | - candidate := candidates detect: [:m | m containsPoint: newPoint] - ifNone: [nil]. - wiringColor := candidate isNil ifTrue: [Color black] ifFalse: [Color red]. - handle - removeAllMorphs; - addMorph: (PolygonMorph - vertices: (Array with: origin with: newPoint) - color: Color black - borderWidth: 1 - borderColor: wiringColor)] - lastPointDo: - [:lastPoint | | wire | - (self wireTo: candidate) - ifTrue: - [wire := (WireMorph - vertices: (Array with: origin with: lastPoint) - color: Color black - borderWidth: 1 - borderColor: Color black) fromPin: self toPin: candidate. - self pasteUpMorph addMorph: wire. - self addWire: wire. - candidate addWire: wire]]. - event hand world addMorph: handle. - handle startStepping! Item was removed: - ----- Method: PinSpec>>modelReadSelector (in category 'accessing') ----- - modelReadSelector - ^ modelReadSelector! Item was removed: - ----- Method: PinSpec>>pinLoc (in category 'accessing') ----- - pinLoc - ^ pinLoc! Item was removed: - ----- Method: PinSpec>>isInput (in category 'accessing') ----- - isInput - direction = #input ifTrue: [^ true]. - direction = #inputOutput ifTrue: [^ true]. - direction = #ioAsInput ifTrue: [^ true]. - ^ false! Item was removed: - ----- Method: Component class>>wantsChangeSetLogging (in category 'compiling') ----- - wantsChangeSetLogging - "Log changes for Component itself, but not for automatically-created subclasses like Component1, Component2" - - "^ self == Component or: - [(self class name beginsWith: 'Component') not]" - - "Log everything for now" - false ifTrue: [self halt "DONT FORGET TO REORDER FILEOUT"]. - ^ true! Item was removed: - ----- Method: PinSpec>>localWriteSelector (in category 'accessing') ----- - localWriteSelector - ^ localWriteSelector! Item was removed: - ----- Method: PinMorph>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - evt shiftPressed ifTrue: [^ self]. - self position: evt targetPoint. - self updateImage! Item was removed: - ----- Method: PinSpec>>modelReadSelector:modelWriteSelector: (in category 'accessing') ----- - modelReadSelector: a modelWriteSelector: b - modelReadSelector := a. - modelWriteSelector := b! Item was removed: - ----- Method: PinSpec>>pinName:direction:localReadSelector:localWriteSelector:modelReadSelector:modelWriteSelector:defaultValue:pinLoc: (in category 'initialization') ----- - pinName: a direction: b localReadSelector: c localWriteSelector: d modelReadSelector: e modelWriteSelector: f defaultValue: g pinLoc: h - pinName := a. - direction := b. - localReadSelector := c. - localWriteSelector := d. - modelReadSelector := e. - modelWriteSelector := f. - defaultValue := g. - pinLoc := h! Item was removed: - PluggableTextMorph subclass: #TextComponent - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Components'! Item was removed: - ----- Method: Component class>>includeInNewMorphMenu (in category 'as yet unclassified') ----- - includeInNewMorphMenu - "Only include instances of subclasses of me" - ^ self ~~ Component! Item was removed: - ----- Method: TextComponent>>initFromPinSpecs (in category 'components') ----- - initFromPinSpecs - | ioPin | - ioPin := pinSpecs first. - getTextSelector := ioPin isInput - ifTrue: [ioPin modelReadSelector] - ifFalse: [nil]. - setTextSelector := ioPin isOutput - ifTrue: [ioPin modelWriteSelector] - ifFalse: [nil]! Item was removed: - ----- Method: PrintComponent>>getText (in category 'model access') ----- - getText - "Retrieve the current model text" - - getTextSelector isNil ifTrue: [^Text new]. - ^(model perform: getTextSelector) printString asText! Item was removed: - ----- Method: PinSpec>>isInputOnly (in category 'accessing') ----- - isInputOnly - direction = #input ifTrue: [^ true]. - direction = #ioAsInput ifTrue: [^ true]. - ^ false! Item was removed: - TextComponent subclass: #PrintComponent - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Components'! Item was removed: - PasteUpMorph subclass: #ComponentLayout - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Components'! Item was removed: - ----- Method: Component>>externalName (in category 'viewer') ----- - externalName - ^ self class name! Item was removed: - Player subclass: #Component - instanceVariableNames: 'model pinSpecs' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Components'! Item was removed: - Object subclass: #PinSpec - instanceVariableNames: 'pinName direction localReadSelector localWriteSelector modelReadSelector modelWriteSelector defaultValue pinLoc' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Components'! Item was removed: - ----- Method: PinMorph>>canDockWith: (in category 'wires') ----- - canDockWith: otherPin - "Later include data type compatibility and circularity as well" - (pinSpec isInputOnly and: [otherPin pinSpec isInputOnly]) ifTrue: [^ false]. - (pinSpec isOutputOnly and: [otherPin pinSpec isOutputOnly]) ifTrue: [^ false]. - ^ true! Item was removed: - ----- Method: PinMorph>>wiringEndPoint (in category 'geometry') ----- - wiringEndPoint - | side | - side := owner bounds sideNearestTo: bounds center. - side = #left ifTrue: [^ self position + (0 at 4)]. - side = #bottom ifTrue: [^ self position + (4 at 7)]. - side = #right ifTrue: [^ self position + (7 at 4)]. - side = #top ifTrue: [^ self position + (4 at 0)]! Item was removed: - ----- Method: PinMorph>>mergeVariableWith: (in category 'variables') ----- - mergeVariableWith: otherPin - "Change all pins with otherPin's selectors to these selectors, - and then remove the slot and accessors for the old selectors" - self removeModelVariable. - self connectedPins do: - [:connectee | connectee shareVariableOf: otherPin]. - self shareVariableOf: otherPin! Item was removed: - ----- Method: ListComponent>>initFromPinSpecs (in category 'components') ----- - initFromPinSpecs - | ioPin | - getListSelector := pinSpecs first modelReadSelector. - ioPin := pinSpecs second. - getIndexSelector := ioPin isInput - ifTrue: [ioPin modelReadSelector] - ifFalse: [nil]. - setIndexSelector := ioPin isOutput - ifTrue: [ioPin modelWriteSelector] - ifFalse: [nil]. - setSelectionSelector := pinSpecs third modelWriteSelector! Item was removed: - ----- Method: WireMorph>>fromPin:toPin: (in category 'as yet unclassified') ----- - fromPin: pin1 toPin: pin2 - pins := Array with: pin1 with: pin2! Item was removed: - ----- Method: WireMorph>>otherPinFrom: (in category 'as yet unclassified') ----- - otherPinFrom: aPin - ^ pins first = aPin ifTrue: [pins second] ifFalse: [pins first]! Item was removed: - ----- Method: PinMorph>>position: (in category 'geometry') ----- - position: p - "Adhere to owner bounds, and apply gridding" - - | r side p1 corners c1 c2 sideIndex | - r := owner bounds. - side := r sideNearestTo: p. - p1 := r pointNearestTo: p. "a point on the border" - p1 := (side = #top or: [side = #left]) - ifTrue: [r topLeft + (p1 - r topLeft grid: 4 @ 4)] - ifFalse: [ r bottomRight + (p1 - r bottomRight grid: 4 @ 4)]. - - "Update pin spec(5) = side index + fraction along side" - corners := r corners. - sideIndex := #(#left #bottom #right #top) indexOf: side. - c1 := corners at: sideIndex. - c2 := corners atWrap: sideIndex + 1. - pinSpec pinLoc: sideIndex + ((p1 dist: c1) / (c2 dist: c1) min: 0.99999). - - "Set new position with appropriate offset." - side = #top ifTrue: [super position: p1 - (0 @ 8)]. - side = #left ifTrue: [super position: p1 - (8 @ 0)]. - side = #bottom ifTrue: [super position: p1]. - side = #right ifTrue: [super position: p1]. - wires do: [:w | w pinMoved]! Item was removed: - ----- Method: PinMorph>>component:pinSpec: (in category 'initialization') ----- - component: aComponent pinSpec: spec - component := aComponent. - pinSpec := spec. - pinSpec isInput ifTrue: [pinForm := InputPinForm]. - pinSpec isOutput ifTrue: [pinForm := OutputPinForm]. - pinSpec isInputOutput ifTrue: [pinForm := IoPinForm]. - self image: pinForm! Item was removed: - ----- Method: WireMorph class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - ^ false! Item was removed: - ----- Method: ListComponent>>list: (in category 'initialization') ----- - list: listOfItems - super list: listOfItems. - self selectionIndex: 0. - selectedItem := nil. - setSelectionSelector ifNotNil: - [model perform: setSelectionSelector with: selectedItem]! Item was removed: - ----- Method: PinMorph>>removeModelVariable (in category 'variables') ----- - removeModelVariable - component model removeVariableNamed: pinSpec variableName. - self removeVariableAccess! Item was removed: - TextComponent subclass: #FunctionComponent - instanceVariableNames: 'inputSelectors functionSelector outputSelector outputValue' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Components'! Item was removed: - ----- Method: FunctionComponent>>getText (in category 'model access') ----- - getText - ^ ('"type a function of' , - (String streamContents: - [:s | - | ps | - 2 to: pinSpecs size do: - [:i | ps := pinSpecs at: i. - (i>2 and: [i = pinSpecs size]) ifTrue: [s nextPutAll: ' and']. - s nextPutAll: ' ', ps pinName]]) , - '"') asText! Item was removed: - ----- Method: Component class>>acceptsLoggingOfCompilation (in category 'compiling') ----- - acceptsLoggingOfCompilation - "Log everything for now" - - ^ true! Item was removed: - ----- Method: PinMorph>>delete (in category 'submorphs-add/remove') ----- - delete - self unwire. - ^ super delete! Item was removed: - ----- Method: Component>>renameMe (in category 'naming') ----- - renameMe - | newName | - newName := self chooseNameLike: self knownName. - newName ifNil: [^ nil]. - self setNamePropertyTo: newName! Item was removed: - ----- Method: PinSpec>>pinName (in category 'accessing') ----- - pinName - ^ pinName! Item was removed: - ----- Method: PinSpec>>isOutput (in category 'accessing') ----- - isOutput - direction = #output ifTrue: [^ true]. - direction = #inputOutput ifTrue: [^ true]. - direction = #ioAsOutput ifTrue: [^ true]. - ^ false! Item was removed: - ----- Method: PinMorph>>removeWire: (in category 'wires') ----- - removeWire: aWireMorph - wires remove: aWireMorph! Item was removed: - ----- Method: ComponentLayout>>acceptDroppingMorph:event: (in category 'layout') ----- - acceptDroppingMorph: aMorph event: evt - "Eschew all of PasteUp's mechanism for now" - - self addMorph: aMorph. - ! Item was removed: - ----- Method: FunctionComponent>>initFromPinSpecs (in category 'components') ----- - initFromPinSpecs - outputSelector := pinSpecs first modelWriteSelector. - inputSelectors := (pinSpecs copyFrom: 2 to: pinSpecs size) - collect: [:ps | ps modelReadSelector]! Item was removed: - ----- Method: PinMorph class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - ^ false! Item was removed: - ----- Method: PinMorph>>pinSpec (in category 'accessing') ----- - pinSpec - ^ pinSpec! Item was removed: - ----- Method: PinMorph>>isIsolated (in category 'wires') ----- - isIsolated - ^ wires isEmpty! Item was removed: - ----- Method: BookMorph>>methodHolders (in category 'scripting') ----- - methodHolders - | all | - "search for all scripts that are in MethodHolders. These are the ones that have versions." - - all := IdentitySet new. - self allMorphsAndBookPagesInto: all. - all := all select: [:mm | mm class = MethodMorph]. - MethodHolders := all asArray collect: [:mm | mm model]. - - ! Item was removed: - ----- Method: FunctionComponent>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aMenu hand: aHandMorph - "Add custom menu items" - - super addCustomMenuItems: aMenu hand: aHandMorph. - aMenu add: 'add pin' translated target: self selector: #addPin. - ! Item was removed: - ----- Method: PrintComponent>>initPinSpecs (in category 'components') ----- - initPinSpecs - pinSpecs := Array - with: (PinSpec new pinName: 'value' direction: #inputOutput - localReadSelector: nil localWriteSelector: nil - modelReadSelector: getTextSelector modelWriteSelector: setTextSelector - defaultValue: nil pinLoc: 1.5)! Item was removed: - ----- Method: Component>>nameMeIn: (in category 'naming') ----- - nameMeIn: aWorld - | stem otherNames i partName className | - className := self class name. - stem := className. - (stem size > 5 and: [stem endsWith: 'Morph']) - ifTrue: [stem := stem copyFrom: 1 to: stem size - 5]. - stem := stem first asLowercase asString , stem allButFirst. - otherNames := Set newFrom: aWorld allKnownNames. - i := 1. - [otherNames includes: (partName := stem , i printString)] - whileTrue: [i := i + 1]. - self setNamePropertyTo: partName! Item was removed: - ----- Method: WireMorph>>delete (in category 'submorphs-add/remove') ----- - delete - pins do: [:p | p removeWire: self]. - pins first isIsolated - ifTrue: [pins first removeVariableAccess. - pins second isIsolated - ifTrue: [pins second removeModelVariable]] - ifFalse: [pins second isIsolated - ifTrue: [pins second removeVariableAccess] - ifFalse: [pins second addModelVariable]]. - super delete! Item was removed: - ----- Method: FunctionComponent>>addPin (in category 'as yet unclassified') ----- - addPin - | i prev sideLength wasNew | - wasNew := self getText = textMorph asText. - i := pinSpecs size. - prev := pinSpecs last. - sideLength := prev pinLoc asInteger odd ifTrue: [self height] ifFalse: [self width]. - pinSpecs := pinSpecs copyWith: - (PinSpec new pinName: ('abcdefghi' copyFrom: i to: i) direction: #input - localReadSelector: nil localWriteSelector: nil - modelReadSelector: nil modelWriteSelector: nil - defaultValue: nil pinLoc: prev pinLoc + (8/sideLength) asFloat \\ 4). - self initFromPinSpecs. - self addPinFromSpec: pinSpecs last. - wasNew ifTrue: [self setText: self getText]. - self accept - !
More information about the Squeak-dev mailing list |