The Inbox: Morphic-spd.459.mcz

A new version of Morphic was added to project The Inbox:
http://source.squeak.org/inbox/Morphic-spd.459.mcz

==================== Summary ====================

Name: Morphic-spd.459
Author: spd
Time: 1 October 2010, 1:00:45.712 pm
UUID: 1b989596-7d30-40b3-aadb-dde767cbd704
Ancestors: Morphic-ar.458

LineMorph class>>from:to:color:width: changed to return a LineMorph

=============== Diff against Morphic-ar.458 ===============

Item was removed:
- ----- Method: BorderedMorph>>closestPointTo: (in category 'geometry') -----
- closestPointTo: aPoint
- "account for round corners. Still has a couple of glitches at upper left and right corners"
- | pt |
- pt := self bounds pointNearestTo: aPoint.
- self wantsRoundedCorners ifFalse: [ ^pt ].
- self bounds corners with: (self bounds insetBy: 6) corners do: [ :out :in |
- (pt - out) abs < (6@6)
- ifTrue: [ ^(in + (Point r: 5.0 degrees: (pt - in) degrees)) asIntegerPoint ].
- ].
- ^pt.!

Item was removed:
- ----- Method: BorderedMorph>>intersectionWithLineSegmentFromCenterTo: (in category 'geometry') -----
- intersectionWithLineSegmentFromCenterTo: aPoint
- "account for round corners. Still has a couple of glitches at upper left and right corners"
- | pt |
- pt := super intersectionWithLineSegmentFromCenterTo: aPoint.
- self wantsRoundedCorners ifFalse: [ ^pt ].
- self bounds corners with: (self bounds insetBy: 6) corners do: [ :out :in |
- (pt - out) abs < (6@6)
- ifTrue: [ ^(in + (Point r: 5.0 degrees: (pt - in) degrees)) asIntegerPoint ].
- ].
- ^pt.!

Item was removed:
- EllipseMorph subclass: #CircleMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Basic'!
-
- !CircleMorph commentStamp: '<historical>' prior: 0!
- I am a specialization of EllipseMorph that knows enough to remain circular.
- !

Item was removed:
- ----- Method: CircleMorph class>>newPin (in category 'as yet unclassified') -----
- newPin
- "Construct a pin for embedded attachment"
- "CircleMorph newPin openInHand"
- ^self new
- removeAllMorphs;
- extent: 18@18;
- hResizing: #rigid;
- vResizing: #rigid;
- layoutPolicy: nil;
- color: Color orange lighter;
- borderColor: Color orange darker;
- borderWidth: 2;
- wantsConnectionWhenEmbedded: true;
- name: 'Pin'!

Item was removed:
- ----- Method: CircleMorph class>>supplementaryPartsDescriptions (in category 'as yet unclassified') -----
- supplementaryPartsDescriptions
- "Extra items for parts bins"
-
- ^ {DescriptionForPartsBin
- formalName: 'Circle1'
- categoryList: #('Graphics')
- documentation: 'A circular shape'
- globalReceiverSymbol: #CircleMorph
- nativitySelector: #newStandAlone.
-
- "DescriptionForPartsBin
- formalName: 'Pin'
- categoryList: #('Connectors')
- documentation: 'An attachment point for Connectors that you can embed in another Morph.'
- globalReceiverSymbol: #NCPinMorph
- nativitySelector: #newPin."
- }!

Item was removed:
- ----- Method: CircleMorph>>addFlexShellIfNecessary (in category 'rotate scale and flex') -----
- addFlexShellIfNecessary
- "When scaling or rotating from a halo, I can do this without a flex shell"
-
- ^ self
- !

Item was removed:
- ----- Method: CircleMorph>>bounds: (in category 'geometry') -----
- bounds: aRectangle
- | size |
- size := aRectangle width min: aRectangle height.
- super bounds: (Rectangle origin: aRectangle origin extent: size @ size).!

Item was removed:
- ----- Method: CircleMorph>>extent: (in category 'geometry') -----
- extent: aPoint
- | size oldRotationCenter |
- oldRotationCenter := self rotationCenter.
- size := aPoint x min: aPoint y.
- super extent: size @ size.
- self rotationCenter: oldRotationCenter.!

Item was removed:
- ----- Method: CircleMorph>>heading: (in category 'geometry eToy') -----
- heading: newHeading
- "Set the receiver's heading (in eToy terms).
- Note that circles never use flex shells."
- self rotationDegrees: newHeading.!

Item was removed:
- ----- Method: CircleMorph>>initialize (in category 'parts bin') -----
- initialize
- super initialize.
- self extent: 40@40;
- color: Color green lighter;
- yourself!

Item was removed:
- ----- Method: CircleMorph>>initializeToStandAlone (in category 'parts bin') -----
- initializeToStandAlone
- ^super initializeToStandAlone
- extent: 40@40;
- color: Color green lighter;
- yourself!

Item was removed:
- ----- Method: CircleMorph>>privateMoveBy: (in category 'rotate scale and flex') -----
- privateMoveBy: delta
- self setProperty: #referencePosition toValue: self referencePosition + delta.
- self setProperty: #originalCenter toValue: (self valueOfProperty: #originalCenter ifAbsent: [ self center ]) + delta.
- super privateMoveBy: delta.
- !

Item was removed:
- ----- Method: CircleMorph>>referencePosition (in category 'geometry eToy') -----
- referencePosition
- "Return the current reference position of the receiver"
- ^ self valueOfProperty: #referencePosition ifAbsent: [ self center ]
- !

Item was removed:
- ----- Method: CircleMorph>>rotationCenter (in category 'geometry eToy') -----
- rotationCenter
- "Return the rotation center of the receiver. The rotation center defines the relative offset inside the receiver's bounds for locating the reference position."
- | refPos |
- refPos := self referencePosition.
- ^ (refPos - self bounds origin) / self bounds extent asFloatPoint!

Item was removed:
- ----- Method: CircleMorph>>rotationCenter: (in category 'geometry eToy') -----
- rotationCenter: aPointOrNil
- "Set the new rotation center of the receiver. The rotation center defines the relative offset inside the receiver's bounds for locating the reference position."
- | newRef box |
- aPointOrNil isNil
- ifTrue: [self removeProperty: #referencePosition.
- self removeProperty: #originalCenter.
- self removeProperty: #originalAngle. ]
- ifFalse: [ box := self bounds.
- newRef := box origin + (aPointOrNil * box extent).
- self setRotationCenterFrom: newRef ].
-
- !

Item was removed:
- ----- Method: CircleMorph>>rotationDegrees (in category 'rotate scale and flex') -----
- rotationDegrees
-
- ^ self forwardDirection!

Item was removed:
- ----- Method: CircleMorph>>rotationDegrees: (in category 'rotate scale and flex') -----
- rotationDegrees: degrees
- | ref newPos flex origAngle origCenter |
- ref := self referencePosition.
- origAngle := self valueOfProperty: #originalAngle ifAbsentPut: [ self heading ].
- origCenter := self valueOfProperty: #originalCenter ifAbsentPut: [ self center ].
- flex := (MorphicTransform offset: ref negated)
- withAngle: (degrees - origAngle) degreesToRadians.
- newPos := (flex transform: origCenter) - flex offset.
- self position: (self position + newPos - self center) asIntegerPoint.
- self setProperty: #referencePosition toValue: ref.
- self setProperty: #originalAngle toValue: origAngle.
- self setProperty: #originalCenter toValue: origCenter.
- self forwardDirection: degrees.
- self changed.
- !

Item was removed:
- ----- Method: CircleMorph>>setRotationCenterFrom: (in category 'menus') -----
- setRotationCenterFrom: aPoint
- "Called by halo rotation code.
- Circles store their referencePosition."
- self setProperty: #referencePosition toValue: aPoint.
- self setProperty: #originalCenter toValue: self center.
- self setProperty: #originalAngle toValue: self heading.!

Item was removed:
- ----- Method: CircleMorph>>transformedBy: (in category 'geometry') -----
- transformedBy: aTransform
- aTransform isIdentity ifTrue:[^self].
- ^self center: (aTransform localPointToGlobal: self center).
- !

Item was removed:
- ----- Method: EllipseMorph>>bottomLeftCorner (in category 'geometry') -----
- bottomLeftCorner
- ^self intersectionWithLineSegmentFromCenterTo: bounds bottomLeft
- !

Item was removed:
- ----- Method: EllipseMorph>>bottomRightCorner (in category 'geometry') -----
- bottomRightCorner
- ^self intersectionWithLineSegmentFromCenterTo: bounds bottomRight
- !

Item was removed:
- ----- Method: EllipseMorph>>closestPointTo: (in category 'geometry') -----
- closestPointTo: aPoint
- ^self intersectionWithLineSegmentFromCenterTo: aPoint!

Item was removed:
- ----- Method: EllipseMorph>>intersectionWithLineSegmentFromCenterTo: (in category 'geometry') -----
- intersectionWithLineSegmentFromCenterTo: aPoint
- | dx aSquared bSquared m mSquared xSquared x y dy |
- (self containsPoint: aPoint)
- ifTrue: [ ^aPoint ].
- dx := aPoint x - self center x.
- dy := aPoint y - self center y.
- dx = 0
- ifTrue: [ ^self bounds pointNearestTo: aPoint ].
- m := dy / dx.
- mSquared := m squared.
- aSquared := (self bounds width / 2) squared.
- bSquared := (self bounds height / 2) squared.
- xSquared := 1 / ((1 / aSquared) + (mSquared / bSquared)).
- x := xSquared sqrt.
- dx < 0 ifTrue: [ x := x negated ].
- y := m * x.
- ^ self center + (x @ y) asIntegerPoint.
- !

Item was removed:
- ----- Method: EllipseMorph>>topLeftCorner (in category 'geometry') -----
- topLeftCorner
- ^self intersectionWithLineSegmentFromCenterTo: bounds topLeft
- !

Item was removed:
- ----- Method: EllipseMorph>>topRightCorner (in category 'geometry') -----
- topRightCorner
- ^self intersectionWithLineSegmentFromCenterTo: bounds topRight
- !

Item was removed:
- ----- Method: HaloMorph>>doDup:with: (in category 'private') -----
- doDup: evt with: dupHandle
- "Ask hand to duplicate my target."
-
- (target isKindOf: SelectionMorph) ifTrue:
- [^ target doDup: evt fromHalo: self handle: dupHandle].
-
- self obtainHaloForEvent: evt andRemoveAllHandlesBut: dupHandle.
- self setTarget: (target duplicateMorph: evt).
- evt hand grabMorph: target.
- self step. "update position if necessary"
- evt hand addMouseListener: self. "Listen for the drop"!

Item was removed:
- ----- Method: HandMorph>>position: (in category 'geometry') -----
- position: aPoint
- "Overridden to align submorph origins to the grid if gridding is on."
- | adjustedPosition delta box |
- adjustedPosition := aPoint.
- temporaryCursor ifNotNil: [adjustedPosition := adjustedPosition + temporaryCursorOffset].
-
- "Copied from Morph to avoid owner layoutChanged"
- "Change the position of this morph and and all of its submorphs."
- delta := adjustedPosition - bounds topLeft.
- (delta x = 0 and: [delta y = 0]) ifTrue: [^ self].  "Null change"
- box := self fullBounds.
- (delta dotProduct: delta) > 100 ifTrue:[
- "e.g., more than 10 pixels moved"
- self invalidRect: box.
- self invalidRect: (box translateBy: delta).
- ] ifFalse:[
- self invalidRect: (box merge: (box translateBy: delta)).
- ].
- self privateFullMoveBy: delta.
- !

Item was removed:
- ----- Method: HandMorph>>visible: (in category 'drawing') -----
- visible: aBoolean
- self needsToBeDrawn ifFalse: [ ^self ].
- super visible: aBoolean!

Item was changed:
  ----- Method: LineMorph class>>from:to:color:width: (in category 'instance creation') -----
  from: startPoint to: endPoint color: lineColor width: lineWidth
 
+ ^ self vertices: {startPoint. endPoint}
- ^ PolygonMorph vertices: {startPoint. endPoint}
  color: Color black borderWidth: lineWidth borderColor: lineColor!

Item was removed:
- ----- Method: Morph>>addMorphFrontFromWorldPosition: (in category 'submorphs-add/remove') -----
- addMorphFrontFromWorldPosition: aMorph
- ^self addMorphFront: aMorph fromWorldPosition: aMorph positionInWorld.!

Item was removed:
- ----- Method: Morph>>allMorphsWithPlayersDo: (in category 'submorphs-add/remove') -----
- allMorphsWithPlayersDo: aTwoArgumentBlock
- "Evaluate the given block for all morphs in this composite morph that have non-nil players.
- Also evaluate the block for the receiver if it has a player."
-
- submorphs do: [:m | m allMorphsWithPlayersDo: aTwoArgumentBlock ].
- self playerRepresented ifNotNil: [ :p | aTwoArgumentBlock value: self value: p ].
- !

Item was removed:
- ----- Method: Morph>>connections (in category 'accessing') -----
- connections
- "Empty method in absence of connectors"
- ^ #()!

Item was removed:
- ----- Method: Morph>>dismissMorph (in category 'meta-actions') -----
- dismissMorph
- "This is called from an explicit halo destroy/delete action."
-
- | w |
- w := self world ifNil:[^self].
- w abandonAllHalos; stopStepping: self.
- self delete!

Item was removed:
- ----- Method: Morph>>dismissMorph: (in category 'meta-actions') -----
- dismissMorph: evt
- self dismissMorph!

Item was removed:
- ----- Method: Morph>>dismissViaHalo (in category 'submorphs-add/remove') -----
- dismissViaHalo
- "The user has clicked in the delete halo-handle.  This provides a hook in case some concomitant action should be taken, or if the particular morph is not one which should be put in the trash can, for example."
-
- | cmd |
- self setProperty: #lastPosition toValue: self positionInWorld.
- self dismissMorph.
- Preferences preserveTrash ifTrue: [
- Preferences slideDismissalsToTrash
- ifTrue:[self slideToTrash: nil]
- ifFalse:[TrashCanMorph moveToTrash: self].
- ].
-
- cmd := Command new cmdWording: 'dismiss ' translated, self externalName.
- cmd undoTarget: ActiveWorld selector: #reintroduceIntoWorld: argument: self.
- cmd redoTarget: ActiveWorld selector: #onceAgainDismiss: argument: self.
- ActiveWorld rememberCommand: cmd!

Item was removed:
- ----- Method: Morph>>embedInto: (in category 'meta-actions') -----
- embedInto: evt
- "Embed the receiver into some other morph"
- |  target morphs |
- morphs := self potentialEmbeddingTargets.
- target := UIManager default
- chooseFrom: (morphs collect:[:m| m knownName ifNil:[m class name asString]])
- values: self potentialEmbeddingTargets
- title: ('Place ', self externalName, ' in...').
- target ifNil:[^self].
- target addMorphFront: self fromWorldPosition: self positionInWorld.!

Item was added:
+ ----- Method: Morph>>filterViewerCategoryDictionary: (in category 'scripting') -----
+ filterViewerCategoryDictionary: dict
+ "dict has keys of categories and values of priority.
+ You can re-order or remove categories here."
+
+ self wantsConnectionVocabulary
+ ifFalse: [ dict removeKey: #'connections to me' ifAbsent: [].
+ dict removeKey: #connection ifAbsent: []].
+ self wantsConnectorVocabulary
+ ifFalse: [ dict removeKey: #connector ifAbsent: [] ].
+ self wantsEmbeddingsVocabulary
+ ifFalse: [dict removeKey: #embeddings ifAbsent: []].
+ Preferences eToyFriendly
+ ifTrue:
+ [dict removeKey: #layout ifAbsent: []].
+ (Preferences eToyFriendly or: [self isWorldMorph not]) ifTrue:
+ [dict removeKey: #preferences ifAbsent: []].!

Item was removed:
- ----- Method: Morph>>innocuousName (in category 'naming') -----
- innocuousName
- "Choose an innocuous name for the receiver -- one that does not end in the word Morph"
-
- | className allKnownNames |
- className := self defaultNameStemForInstances.
- (className size > 5 and: [className endsWith: 'Morph'])
- ifTrue: [className := className copyFrom: 1 to: className size - 5].
- className := className asString translated.
- allKnownNames := self world ifNil: [OrderedCollection new] ifNotNil: [self world allKnownNames].
- ^ Utilities keyLike: className asString satisfying:
- [:aName | (allKnownNames includes: aName) not]!

Item was removed:
- ----- Method: Morph>>intersects: (in category 'geometry') -----
- intersects: aRectangle
- "Answer whether aRectangle, which is in World coordinates, intersects me."
-
- ^self fullBoundsInWorld intersects: aRectangle!

Item was removed:
- ----- Method: Morph>>isLineMorph (in category 'testing') -----
- isLineMorph
- ^false!

Item was removed:
- ----- Method: Morph>>model (in category 'menus') -----
- model
- ^ nil !

Item was removed:
- ----- Method: Morph>>overlapsShadowForm:bounds: (in category 'geometry') -----
- overlapsShadowForm: itsShadow bounds: itsBounds
- "Answer true if itsShadow and my shadow overlap at all"
- | andForm overlapExtent |
- overlapExtent := (itsBounds intersect: self fullBounds) extent.
- overlapExtent > (0 @ 0)
- ifFalse: [^ false].
- andForm := self shadowForm.
- overlapExtent ~= self fullBounds extent
- ifTrue: [andForm := andForm
- contentsOfArea: (0 @ 0 extent: overlapExtent)].
- andForm := andForm
- copyBits: (self fullBounds translateBy: itsShadow offset negated)
- from: itsShadow
- at: 0 @ 0
- clippingBox: (0 @ 0 extent: overlapExtent)
- rule: Form and
- fillColor: nil.
- ^ andForm bits
- anySatisfy: [:w | w ~= 0]!

Item was removed:
- ----- Method: Morph>>playerRepresented (in category 'accessing') -----
- playerRepresented
- "Answer the player represented by the receiver.  Morphs that serve as references to other morphs reimplement this; be default a morph represents its own player."
-
- ^ self player!

Item was removed:
- ----- Method: Morph>>removedMorph: (in category 'submorphs-add/remove') -----
- removedMorph: aMorph
- "Notify the receiver that aMorph was just removed from its children"
- !

Item was removed:
- ----- Method: Morph>>renameTo: (in category 'testing') -----
- 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 keyAtIdentityValue: renderer player ifAbsent: [].
- oldKey ifNotNil:
- [assoc := References associationAt: oldKey.
- oldKey = aName
- ifFalse:
- ["normal rename"
-
- assoc key: (renderer player uniqueNameForReferenceFrom: aName).
- References 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 := (self systemNavigation 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"
-
- nil.
- (mm isScriptEditorMorph)
- ifTrue:
- [((mm playerScripted class compiledMethodAt: mm scriptName)
- hasLiteral: assoc)
- ifTrue:
- [mm
- hibernate;
- unhibernate]]]].
- ^aName!

Item was removed:
- ----- Method: Morph>>slideToTrash: (in category 'dropping/grabbing') -----
- slideToTrash: evt
- "Perhaps slide the receiver across the screen to a trash can and make it disappear into it.  In any case, remove the receiver from the screen."
-
- | aForm trash startPoint endPoint morphToSlide |
- ((self renderedMorph == Utilities scrapsBook) or: [self renderedMorph isKindOf: TrashCanMorph]) ifTrue:
- [self dismissMorph.  ^ self].
- Preferences slideDismissalsToTrash ifTrue:
- [morphToSlide := self representativeNoTallerThan: 200 norWiderThan: 200 thumbnailHeight: 100.
- aForm := morphToSlide imageForm offset: (0@0).
- trash := ActiveWorld
- findDeepSubmorphThat:
- [:aMorph | (aMorph isKindOf: TrashCanMorph) and:
- [aMorph topRendererOrSelf owner == ActiveWorld]]
- ifAbsent:
- [trash := TrashCanMorph new.
- trash bottomLeft: ActiveWorld bottomLeft - (-10@10).
- trash openInWorld.
- trash].
- endPoint := trash fullBoundsInWorld center.
- startPoint := self topRendererOrSelf fullBoundsInWorld center - (aForm extent // 2)].
- self dismissMorph.
- ActiveWorld displayWorld.
- Preferences slideDismissalsToTrash ifTrue:
- [aForm slideFrom: startPoint to: endPoint nSteps: 12 delay: 15].
- Utilities addToTrash: self!

Item was removed:
- ----- Method: Morph>>wantsConnectorVocabulary (in category 'connectors-scripting') -----
- wantsConnectorVocabulary
- "Answer true if I want to show a 'connector' vocabulary"
- ^false!

Item was removed:
- ----- Method: Morph>>wantsEmbeddingsVocabulary (in category 'accessing') -----
- wantsEmbeddingsVocabulary
- "Empty method in absence of connectors"
- ^ false!

Item was removed:
- ----- Method: PasteUpMorph>>deleteAllHalos (in category 'world state') -----
- deleteAllHalos
-
- self haloMorphs
- do: [:each | (each target isKindOf: SelectionMorph)
- ifTrue: [each target delete]].
- self hands
- do: [:each | each removeHalo]!

Item was removed:
- ----- Method: PolygonMorph>>arrows (in category 'menu') -----
- arrows
- ^arrows!

Item was removed:
- ----- Method: PolygonMorph>>arrowsContainPoint: (in category 'geometry') -----
- arrowsContainPoint: aPoint
- "Answer an Array of two Booleans that indicate whether the given point is inside either arrow"
-
- | retval f |
-
- retval := { false . false }.
- (super containsPoint: aPoint) ifFalse: [^ retval ].
- (closed or: [arrows == #none or: [vertices size < 2]]) ifTrue: [^ retval].
-
- (arrows == #forward or: [arrows == #both]) ifTrue: [ "arrowForms first has end form"
- f := self arrowForms first.
- retval at: 2 put: ((f pixelValueAt: aPoint - f offset) > 0)
- ].
- (arrows == #back or: [arrows == #both]) ifTrue: [ "arrowForms last has start form"
- f := self arrowForms last.
- retval at: 1 put: ((f pixelValueAt: aPoint - f offset) > 0)
- ].
- ^retval.!

Item was removed:
- ----- Method: PolygonMorph>>boundsSignatureHash (in category 'attachments') -----
- boundsSignatureHash
- ^(vertices - (self positionInWorld))  hash
- !

Item was removed:
- ----- Method: PolygonMorph>>closestSegmentTo: (in category 'geometry') -----
- closestSegmentTo: aPoint
- "Answer the starting index of my (big) segment nearest to aPoint"
- | closestPoint minDist vertexIndex closestVertexIndex |
- vertexIndex := 0.
- closestVertexIndex := 0.
- closestPoint := minDist := nil.
- self lineSegmentsDo:
- [:p1 :p2 | | dist curvePoint |
- (p1 = (self vertices at: vertexIndex + 1))
- ifTrue: [ vertexIndex := vertexIndex + 1 ].
- curvePoint := aPoint nearestPointOnLineFrom: p1 to: p2.
- dist := curvePoint dist: aPoint.
- (closestPoint == nil or: [dist < minDist])
- ifTrue: [closestPoint := curvePoint.
- minDist := dist.
- closestVertexIndex := vertexIndex. ]].
- ^ closestVertexIndex!

Item was removed:
- ----- Method: PolygonMorph>>dashedBorder (in category 'dashes') -----
- dashedBorder
- ^borderDashSpec
- "A dash spec is a 3- or 5-element array with
- { length of normal border color.
- length of alternate border color.
- alternate border color.
- starting offset.
- amount to add to offset at each step }
- Starting offset is usually = 0, but changing it moves the dashes along the curve."
- !

Item was removed:
- ----- Method: PolygonMorph>>defaultAttachmentPointSpecs (in category 'attachments') -----
- defaultAttachmentPointSpecs
- ^{
- { #firstVertex } .
- { #midpoint  } .
- { #lastVertex }
- }!

Item was removed:
- ----- Method: PolygonMorph>>drawArrowsOn: (in category 'drawing') -----
- drawArrowsOn: aCanvas
- "Answer (possibly modified) endpoints for border drawing"
- "ArrowForms are computed only upon demand"
- | array |
-
- self hasArrows
- ifFalse: [^ #() ].
- "Nothing to do"
-
- array := Array with: vertices first with: vertices last.
-
- "Prevent crashes for #raised or #inset borders"
- borderColor isColor
- ifFalse: [ ^array ].
-
- (arrows == #forward or: [arrows == #both])
- ifTrue: [ array at: 2 put: (self
- drawArrowOn: aCanvas
- at: vertices last
- from: self nextToLastPoint) ].
-
- (arrows == #back or: [arrows == #both])
- ifTrue: [ array at: 1 put: (self
- drawArrowOn: aCanvas
- at: vertices first
- from: self nextToFirstPoint) ].
-
- ^array!

Item was removed:
- ----- Method: PolygonMorph>>endShapeColor: (in category 'attachments') -----
- endShapeColor: aColor
- self borderColor: aColor.
- self isClosed ifTrue: [ self color: aColor ].!

Item was removed:
- ----- Method: PolygonMorph>>endShapeWidth: (in category 'attachments') -----
- endShapeWidth: aWidth
- | originalWidth originalVertices transform |
- originalWidth := self valueOfProperty: #originalWidth ifAbsentPut: [ self borderWidth isZero ifFalse: [ self borderWidth ] ifTrue: [ 2 ] ].
- self borderWidth: aWidth.
- originalVertices := self valueOfProperty: #originalVertices ifAbsentPut: [
- self vertices collect: [ :ea | (ea - (self referencePosition)) rotateBy: self heading degreesToRadians about: 0@0 ]
- ].
- transform := MorphicTransform offset: 0@0 angle: self heading degreesToRadians scale: originalWidth / aWidth.
- self setVertices: (originalVertices collect: [ :ea |
- ((transform transform: ea) + self referencePosition) asIntegerPoint
- ]).
- self computeBounds.!

Item was removed:
- ----- Method: PolygonMorph>>firstVertex (in category 'attachments') -----
- firstVertex
- ^vertices first!

Item was removed:
- ----- Method: PolygonMorph>>intersectionWithLineSegmentFromCenterTo: (in category 'geometry') -----
- intersectionWithLineSegmentFromCenterTo: aPoint
- ^self closestPointTo: aPoint!

Item was removed:
- ----- Method: PolygonMorph>>intersectionsWith: (in category 'geometry') -----
- intersectionsWith: aRectangle
- "Answer a Set of points where the given Rectangle intersects with me.
- Ignores arrowForms."
-
- | retval |
- retval := IdentitySet new: 4.
- (self bounds intersects: aRectangle) ifFalse: [^ retval].
-
- self lineSegmentsDo: [ :lp1 :lp2 | | polySeg |
- polySeg := LineSegment from: lp1 to: lp2.
- aRectangle lineSegmentsDo: [ :rp1 :rp2 | | rectSeg int |
- rectSeg := LineSegment from: rp1 to: rp2.
- int := polySeg intersectionWith: rectSeg.
- int ifNotNil: [ retval add: int ].
- ].
- ].
-
- ^retval
- !

Item was removed:
- ----- Method: PolygonMorph>>intersects: (in category 'geometry') -----
- intersects: aRectangle
- "Answer whether any of my segments intersects aRectangle, which is in World coordinates."
- | rect |
- (super intersects: aRectangle) ifFalse: [ ^false ].
- rect := self bounds: aRectangle in: self world.
- self
- lineSegmentsDo: [:p1 :p2 | (rect intersectsLineFrom: p1 to: p2)
- ifTrue: [^ true]].
- ^ false!

Item was removed:
- ----- Method: PolygonMorph>>isBordered (in category 'geometry') -----
- isBordered
- ^false!

Item was removed:
- ----- Method: PolygonMorph>>isLineMorph (in category 'testing') -----
- isLineMorph
- ^closed not!

Item was removed:
- ----- Method: PolygonMorph>>lastVertex (in category 'attachments') -----
- lastVertex
- ^vertices last!

Item was removed:
- ----- Method: PolygonMorph>>lineBorderColor (in category 'geometry') -----
- lineBorderColor
- ^self borderColor!

Item was removed:
- ----- Method: PolygonMorph>>lineBorderColor: (in category 'geometry') -----
- lineBorderColor: aColor
- self borderColor: aColor!

Item was removed:
- ----- Method: PolygonMorph>>lineBorderWidth (in category 'geometry') -----
- lineBorderWidth
-
- ^self borderWidth!

Item was removed:
- ----- Method: PolygonMorph>>lineBorderWidth: (in category 'geometry') -----
- lineBorderWidth: anInteger
-
- self borderWidth: anInteger!

Item was removed:
- ----- Method: PolygonMorph>>lineColor (in category 'geometry') -----
- lineColor
- ^self borderColor!

Item was removed:
- ----- Method: PolygonMorph>>lineColor: (in category 'geometry') -----
- lineColor: aColor
- self borderColor: aColor!

Item was removed:
- ----- Method: PolygonMorph>>lineWidth (in category 'geometry') -----
- lineWidth
-
- ^self borderWidth!

Item was removed:
- ----- Method: PolygonMorph>>lineWidth: (in category 'geometry') -----
- lineWidth: anInteger
-
- self borderWidth: (anInteger rounded max: 1)!

Item was removed:
- ----- Method: PolygonMorph>>midpoint (in category 'attachments') -----
- midpoint
- "Answer the midpoint along my segments"
- | middle |
- middle := self totalLength.
- middle < 2 ifTrue: [ ^ self center ].
- middle := middle / 2.
- self lineSegmentsDo: [ :a :b | | dist |
- dist := (a dist: b).
- middle < dist
- ifTrue: [ ^(a + ((b - a) * (middle / dist))) asIntegerPoint ].
- middle := middle - dist.
- ].
- self error: 'can''t happen'!

Item was removed:
- ----- Method: PolygonMorph>>nextDuplicateVertexIndex (in category 'geometry') -----
- nextDuplicateVertexIndex
- vertices
- doWithIndex: [:vert :index | ((index between: 2 and: vertices size - 1)
- and: [| epsilon v1 v2 |
- v1 := vertices at: index - 1.
- v2 := vertices at: index + 1.
- epsilon := ((v1 x - v2 x) abs max: (v1 y - v2 y) abs)
- // 32 max: 1.
- vert
- onLineFrom: v1
- to: v2
- within: epsilon])
- ifTrue: [^ index]].
- ^ 0!

Item was removed:
- ----- Method: PolygonMorph>>nudgeForLabel: (in category 'attachments') -----
- nudgeForLabel: aRectangle
- "Try to move the label off me. Prefer labels on the top and right."
-
- | i flags nudge |
- (self bounds intersects: aRectangle) ifFalse: [^ 0@0 ].
- flags := 0.
- nudge := 0@0.
- i := 1.
- aRectangle lineSegmentsDo: [ :rp1 :rp2 | | rectSeg |
- rectSeg := LineSegment from: rp1 to: rp2.
- self straightLineSegmentsDo: [ :lp1 :lp2 | | polySeg int |
- polySeg := LineSegment from: lp1 to: lp2.
- int := polySeg intersectionWith: rectSeg.
- int ifNotNil: [ flags := flags bitOr: i ].
- ].
- i := i * 2.
- ].
- "Now flags has bitflags for which sides"
- nudge := flags caseOf: {
- "no intersection"
- [ 0 ] -> [ 0@0 ].
- "2 adjacent sides only"
- [ 9 ] -> [ 1@1 ].
- [ 3 ] -> [ -1@1 ].
- [ 12 ] -> [ 1@-1 ].
- [ 6 ] -> [ -1@-1 ].
- "2 opposite sides only"
- [ 10 ] -> [ 0@-1 ].
- [ 5 ] -> [ 1@0 ].
- "only 1 side"
- [ 8 ] -> [ -1@0 ].
- [ 1 ] -> [ 0@-1 ].
- [ 2 ] -> [ 1@0 ].
- [ 4 ] -> [ 0@1 ].
- "3 sides"
- [ 11 ] -> [ 0@1 ].
- [ 13 ] -> [ 1@0 ].
- [ 14 ] -> [ 0@-1 ].
- [ 7 ] -> [ -1@0 ].
-  "all sides"
- [ 15 ] -> [ 1@-1 "move up and to the right" ].
- }.
- ^nudge!

Item was removed:
- ----- Method: PolygonMorph>>reduceVertices (in category 'geometry') -----
- reduceVertices
- "Reduces the vertices size, when 3 vertices are on the same line with a
- little epsilon. Based on code by Steffen Mueller"
- | dup |
- [ (dup := self nextDuplicateVertexIndex) > 0 ] whileTrue: [
- self setVertices: (vertices copyWithoutIndex: dup)
- ].
- ^vertices size.!

Item was removed:
- ----- Method: PolygonMorph>>removeVertex: (in category 'dashes') -----
- removeVertex: aVert
- "Make sure that I am not left with less than two vertices"
- | newVertices |
- vertices size < 2 ifTrue: [ ^self ].
- newVertices := vertices copyWithout: aVert.
- newVertices size caseOf: {
- [1] -> [ newVertices := { newVertices first . newVertices first } ].
- [0] -> [ newVertices := { aVert . aVert } ]
- } otherwise: [].
- self setVertices: newVertices
- !

Item was removed:
- ----- Method: PolygonMorph>>straightLineSegmentsDo: (in category 'smoothing') -----
- straightLineSegmentsDo: endPointsBlock
- "Emit a sequence of segment endpoints into endPointsBlock.
- Work the same way regardless of whether I'm curved."
- | beginPoint |
- beginPoint := nil.
- vertices do:
- [:vert | beginPoint ifNotNil:
- [endPointsBlock value: beginPoint
- value: vert].
- beginPoint := vert].
- (closed or: [vertices size = 1])
- ifTrue: [endPointsBlock value: beginPoint
- value: vertices first].!

Item was removed:
- ----- Method: PolygonMorph>>straighten (in category 'geometry') -----
- straighten
- self setVertices: { vertices first . vertices last }!

Item was removed:
- ----- Method: PolygonMorph>>totalLength (in category 'attachments') -----
- totalLength
- "Answer the full length of my segments. Can take a long time if I'm curved."
- | length |
- length := 0.
- self lineSegmentsDo: [ :a :b | length := length + (a dist: b) ].
- ^length.!

Item was removed:
- ----- Method: PolygonMorph>>transformVerticesFrom:to: (in category 'private') -----
- transformVerticesFrom: oldOwner to: newOwner
- | oldTransform newTransform world newVertices |
- world := self world.
- oldTransform := oldOwner
- ifNil: [ IdentityTransform new ]
- ifNotNil: [ oldOwner transformFrom: world ].
- newTransform := newOwner
- ifNil: [ IdentityTransform new ]
- ifNotNil: [ newOwner transformFrom: world ].
- newVertices := vertices collect: [ :ea | newTransform globalPointToLocal:
- (oldTransform localPointToGlobal: ea) ].
- self setVertices: newVertices.
- !

Item was removed:
- ----- Method: PolygonMorph>>vertexAt: (in category 'dashes') -----
- vertexAt: n
- ^vertices at: (n min: vertices size).!

Item was removed:
- ----- Method: Presenter>>viewMorph: (in category 'stubs') -----
- viewMorph: aMorph
- aMorph inspect.
- !

Item was removed:
- ----- Method: SelectionMorph>>addOrRemoveItems: (in category 'halo commands') -----
- addOrRemoveItems: handOrEvent
- "Make a new selection extending the current one."
-
- | hand |
- hand := (handOrEvent isMorphicEvent)
- ifFalse: [handOrEvent]
- ifTrue: [handOrEvent hand].
- hand
- addMorphBack: ((self class
- newBounds: (hand lastEvent cursorPoint extent: 16 @ 16))
- setOtherSelection: self).
- !

Item was removed:
- ----- Method: SketchMorph>>changePixelsOfColor:toColor: (in category 'menus') -----
- changePixelsOfColor: c toColor: newColor
-
- | r |
- originalForm mapColor: c to: newColor.
- r := originalForm rectangleEnclosingPixelsNotOfColor: Color transparent.
- self form: (originalForm copy: r).
-
- !

Item was removed:
- ----- Method: SketchMorph>>firstIntersectionWithLineFrom:to: (in category 'geometry') -----
- firstIntersectionWithLineFrom: start to: end
- | intersections last |
- intersections := self fullBounds extrapolatedIntersectionsWithLineFrom: start to: end.
- intersections size = 1 ifTrue: [ ^intersections anyOne ].
- intersections isEmpty ifTrue: [ ^nil ].
- intersections := intersections asSortedCollection: [ :a :b | (start dist: a) < (start dist: b) ].
- last := intersections first rounded.
- last pointsTo: intersections last rounded do: [ :pt |
- (self rotatedForm isTransparentAt: (pt - bounds origin)) ifFalse: [ ^last ].
- last := pt.
- ].
- ^intersections first rounded!

Item was removed:
- ----- Method: StringMorph>>minHeight (in category 'connectors-layout') -----
- minHeight
- "answer the receiver's minHeight"
- ^ self fontToUse height!

Item was removed:
- ----- Method: StringMorphEditor>>keyboardFocusChange: (in category 'event handling') -----
- keyboardFocusChange: aBoolean
- | hadFocus |
- owner ifNil: [ ^self ].
- hadFocus := owner hasFocus.
- super keyboardFocusChange: aBoolean.
- aBoolean ifFalse:
- [hadFocus ifTrue:
- [owner lostFocusWithoutAccepting; doneWithEdits].
- ^ self delete]!

Item was removed:
- ----- Method: TTSampleFontMorph class>>fontWithoutString: (in category 'connectors') -----
- fontWithoutString: aTTFontDescription
- ^self new fontWithoutString: aTTFontDescription!

Item was removed:
- ----- Method: TTSampleFontMorph>>fontWithoutString: (in category 'connectors') -----
- fontWithoutString: aTTFontDescription
- font := aTTFontDescription.
- !

Item was removed:
- ----- Method: TTSampleFontMorph>>glyphAt: (in category 'connectors') -----
- glyphAt: position
- ^font at: (self glyphIndexAt: position).!

Item was removed:
- ----- Method: TTSampleFontMorph>>glyphIndexAt: (in category 'connectors') -----
- glyphIndexAt: position
- | offset |
- offset := (position adhereTo: (bounds insetBy: 1)) - bounds origin.
- offset := (offset asFloatPoint / bounds extent) * 16.
- offset := offset truncated.
- ^offset y * 16 + offset x!

Item was removed:
- ----- Method: TTSampleFontMorph>>printOn: (in category 'connectors') -----
- printOn: aStream
- aStream nextPutAll: 'TTSampleFont(';
- nextPutAll: font familyName;
- nextPut: $)!

Item was removed:
- ----- Method: TTSampleFontMorph>>selectGlyph (in category 'connectors') -----
- selectGlyph
- | retval done |
- "Modal glyph selector"
- done := false.
- self on: #mouseDown send: #selectGlyphBlock:event:from: to: self withValue: [ :glyph | retval := glyph. done := true. ].
- self on: #keyStroke send: #value to: [ done := true ].
- [ done ] whileFalse: [ self world doOneCycle ].
- self on: #mouseDown send: nil to: nil.
- self on: #keyStroke send: nil to: nil.
- ^retval!

Item was removed:
- ----- Method: TTSampleFontMorph>>selectGlyphAndSendTo: (in category 'connectors') -----
- selectGlyphAndSendTo: aBlock
- self on: #mouseDown send: #selectGlyphBlock:event:from: to: self withValue: aBlock.!

Item was removed:
- ----- Method: TTSampleFontMorph>>selectGlyphBlock:event:from: (in category 'connectors') -----
- selectGlyphBlock: aBlock event: evt from: me
- aBlock value: (self glyphAt: evt position).
- !

Item was removed:
- ----- Method: TTSampleStringMorph>>printOn: (in category 'printing') -----
- printOn: aStream
- aStream nextPutAll: 'TTSampleString(';
- nextPutAll: font familyName;
- nextPut: $)!

Item was removed:
- ----- Method: TextMorph class>>boldAuthoringPrototype (in category 'connectorstext-parts bin') -----
- boldAuthoringPrototype
- "TextMorph boldAuthoringPrototype openInHand"
- | text |
- text := Text string: 'Text' translated attributes: { TextEmphasis bold. }.
- ^self new
- contentsWrapped: text;
- fontName: 'BitstreamVeraSans' pointSize: 24;
- paragraph;
- extent: 79@36;
- margins: 4@0;
- fit;
- yourself
- !

Item was removed:
- ----- Method: TextMorph>>addCustomMenuItems:hand: (in category 'menu') -----
- addCustomMenuItems: aCustomMenu hand: aHandMorph
- | outer |
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- aCustomMenu add: 'text properties...' translated action: #changeTextColor.
- aCustomMenu addUpdating: #autoFitString target: self action: #autoFitOnOff.
- aCustomMenu addUpdating: #wrapString target: self action: #wrapOnOff.
- aCustomMenu add: 'text margins...' translated action: #changeMargins:.
- aCustomMenu add: 'add predecessor' translated action: #addPredecessor:.
- aCustomMenu add: 'add successor' translated action: #addSuccessor:.
-
- outer := self owner.
- outer ifNotNil: [
- outer isLineMorph ifTrue:
- [container isNil
- ifTrue: [aCustomMenu add: 'follow owner''s curve' translated action: #followCurve]
- ifFalse: [aCustomMenu add: 'reverse direction' translated action: #reverseCurveDirection.
- aCustomMenu add: 'set baseline' translated action: #setCurveBaseline:]]
- ifFalse:
- [self fillsOwner
- ifFalse: [aCustomMenu add: 'fill owner''s shape' translated action: #fillingOnOff]
- ifTrue: [aCustomMenu add: 'rectangular bounds' translated action: #fillingOnOff].
- self avoidsOcclusions
- ifFalse: [aCustomMenu add: 'avoid occlusions' translated action: #occlusionsOnOff]
- ifTrue: [aCustomMenu add: 'ignore occlusions' translated action: #occlusionsOnOff]]].
- aCustomMenu addLine.
- aCustomMenu add: 'holder for characters' translated action: #holderForCharacters
- !

Item was removed:
- ----- Method: TextMorph>>avoidsOcclusions (in category 'containment') -----
- avoidsOcclusions
- ^container notNil and: [ container avoidsOcclusions ]
- !

Item was removed:
- ----- Method: TextMorph>>fillingOnOff (in category 'containment') -----
- fillingOnOff
- "Establish a container for this text, with opposite filling status"
- self fillsOwner: (self fillsOwner not)!

Item was removed:
- ----- Method: TextMorph>>fillsOwner (in category 'containment') -----
- fillsOwner
- "Answer true if I fill my owner's shape."
- ^container notNil and: [container fillsOwner]!

Item was removed:
- ----- Method: TextMorph>>fillsOwner: (in category 'containment') -----
- fillsOwner: aBoolean
- self fillsOwner == aBoolean
- ifTrue: [^ self].
- self
- setContainer: (aBoolean
- ifTrue: [wrapFlag := true.
- container
- ifNil: [TextContainer new for: self minWidth: textStyle lineGrid * 2]
- ifNotNil: [container fillsOwner: true]]
- ifFalse: [self avoidsOcclusions
- ifFalse: [ nil ]
- ifTrue: [container fillsOwner: false]])!

Item was removed:
- ----- Method: TextMorph>>font: (in category 'accessing') -----
- font: aFont
- | newTextStyle |
- newTextStyle := aFont textStyle copy ifNil: [ TextStyle fontArray: { aFont } ].
- textStyle := newTextStyle.
- text addAttribute: (TextFontChange fontNumber: (newTextStyle fontIndexOf: aFont)).
- paragraph ifNotNil: [paragraph textStyle: newTextStyle]!

Item was removed:
- ----- Method: TextMorph>>fontName:pointSize: (in category 'accessing') -----
- fontName: fontName pointSize: fontSize
- | newTextStyle |
- newTextStyle := ((TextStyle named: fontName asSymbol) ifNil: [ TextStyle default ]) copy.
- newTextStyle ifNil: [self error: 'font ', fontName, ' not found.'].
-
- textStyle := newTextStyle.
- text addAttribute: (TextFontChange fontNumber: (newTextStyle fontIndexOfPointSize: fontSize)).
- paragraph ifNotNil: [paragraph textStyle: newTextStyle]!

Item was removed:
- ----- Method: TextMorph>>fontName:size: (in category 'accessing') -----
- fontName: fontName size: fontSize
- | newTextStyle |
- newTextStyle := ((TextStyle named: fontName asSymbol) ifNil: [ TextStyle default ]) copy.
- textStyle := newTextStyle.
- text addAttribute: (TextFontChange fontNumber: (newTextStyle fontIndexOfSize: fontSize)).
- paragraph ifNotNil: [paragraph textStyle: newTextStyle]!

Item was removed:
- ----- Method: TextMorph>>selectAll (in category 'accessing') -----
- selectAll
- self editor selectFrom: 1 to: text size!

Item was removed:
- ----- Method: TextMorph>>selectFrom:to: (in category 'accessing') -----
- selectFrom: a to: b
- self editor selectFrom: a to: b!

Item was removed:
- ----- Method: TextMorph>>selection (in category 'accessing') -----
- selection
- ^editor ifNotNil: [ editor selection ]!

On 2010/10/01 17:01, [hidden email] wrote:
I know precious little about Morphic, but I'm a bit confused:

1. Most of the commit seems to have nothing to do with LineMorphs.

2. LineMorph class>>from:to:color:width: now returns a PolygonMorph, not
a LineMorph. (LineMorph subclasses PolygonMorph.
3. Morphic-ar.458's pretty old. My not-quite-up-to-date image is on
Morphic-laza.468 already.

frank

Frank Shearar wrote

I know precious little about Morphic, but I'm a bit confused:

Me too!

Frank Shearar wrote

1. Most of the commit seems to have nothing to do with LineMorphs.

2. LineMorph class>>from:to:color:width: now returns a PolygonMorph, not
a LineMorph. (LineMorph subclasses PolygonMorph.
3. Morphic-ar.458's pretty old. My not-quite-up-to-date image is on
Morphic-laza.468 already.

I uploaded Morphic-spd.469 from a current trunk image.  That looks correct and supersedes this one.